From 3e7718e76e61411b28908edb15bf48685bd0d9f7 Mon Sep 17 00:00:00 2001 From: Ron Pinkas Date: Sun, 7 May 2000 12:27:18 +0000 Subject: [PATCH] 20000507-05:20 GMT-8 Ron Pinkas * include/hbpcomp.c + Added pPrivates to structure FUNCTION. * source/compiler/harbour.c + Added logic to maintain linked list pPrivates of pFunc. * source/compiler/harbour.y + Added support for MEMVAR AS ... syntax. * source/compiler/hbpcode.c + Added support for FIELD AS ... and MEMVAR AS both local and global. ! More refinments * tests/testwarn.prg + Added code to demonstrate "Adaptive Type Checking". --- harbour/ChangeLog | 20 +- harbour/include/hbcomp.h | 1 + harbour/source/compiler/harbour.c | 89 +++++++- harbour/source/compiler/harbour.y | 2 +- harbour/source/compiler/hbpcode.c | 325 +++++++++++++++++++----------- harbour/tests/testwarn.prg | 44 ++++ 6 files changed, 362 insertions(+), 119 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 9cf69e111c..5ef81c4f73 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,21 @@ +20000507-05:20 GMT-8 Ron Pinkas + + * include/hbpcomp.c + + Added pPrivates to structure FUNCTION. + + * source/compiler/harbour.c + + Added logic to maintain linked list pPrivates of pFunc. + + * source/compiler/harbour.y + + Added support for MEMVAR AS ... syntax. + + * source/compiler/hbpcode.c + + Added support for FIELD AS ... and MEMVAR AS both local and global. + ! More refinments + + * tests/testwarn.prg + + Added code to demonstrate "Adaptive Type Checking". + 20000507-14:05 GMT+1 Ryszard Glab *include/hbapi.h @@ -6,7 +24,7 @@ *source/rtl/memvars.c * hb_memvarScope() function has now a global scope * fixed the value returned by TYPE() function for variables - not visible at runtime (now returns 'U' instead of 'UE') + not visible at runtime (now returns 'U' instead of 'UE') 20000507-09:40 GMT+1 Victor Szakats diff --git a/harbour/include/hbcomp.h b/harbour/include/hbcomp.h index de46e1806c..f8ddab5b56 100644 --- a/harbour/include/hbcomp.h +++ b/harbour/include/hbcomp.h @@ -109,6 +109,7 @@ typedef struct __FUNC PVAR pStatics; /* pointer to static variables list */ PVAR pFields; /* pointer to fields variables list */ PVAR pMemvars; /* pointer to memvar variables list */ + PVAR pPrivates; /* pointer to private variables list */ BYTE * pCode; /* pointer to a memory block where pcode is stored */ ULONG lPCodeSize; /* total memory size for pcode */ ULONG lPCodePos; /* actual pcode offset */ diff --git a/harbour/source/compiler/harbour.c b/harbour/source/compiler/harbour.c index 719cfb4290..f14aa0c054 100644 --- a/harbour/source/compiler/harbour.c +++ b/harbour/source/compiler/harbour.c @@ -537,7 +537,9 @@ void hb_compVariableAdd( char * szVarName, BYTE cValueType ) PCOMSYMBOL pSym; USHORT wPos; - if( hb_comp_bAutoMemvarAssume || hb_comp_iVarScope & VS_MEMVAR ) + //printf( "\nAdding: %s in Function: %s\n", pVar->szName, pFunc->szName ); + + if( hb_comp_bAutoMemvarAssume || hb_comp_iVarScope == VS_MEMVAR ) { /* add this variable to the list of MEMVAR variables */ @@ -557,6 +559,7 @@ void hb_compVariableAdd( char * szVarName, BYTE cValueType ) case VS_MEMVAR: /* variable declared in MEMVAR statement */ break; + case ( VS_PARAMETER | VS_PRIVATE ): { if( ++hb_comp_functions.pLast->wParamNum > hb_comp_functions.pLast->wParamCount ) @@ -567,18 +570,87 @@ void hb_compVariableAdd( char * szVarName, BYTE cValueType ) pSym = hb_compSymbolFind( szVarName, &wPos ); /* check if symbol exists already */ if( ! pSym ) pSym = hb_compSymbolAdd( hb_strdup( szVarName ), &wPos ); + pSym->cScope |= VS_MEMVAR; + + //printf( "\nAdded Symbol: %s Pos: %i\n", pSym->szName, wPos ); + hb_compGenPCode4( HB_P_PARAMETER, HB_LOBYTE( wPos ), HB_HIBYTE( wPos ), HB_LOBYTE( hb_comp_functions.pLast->wParamNum ), ( BOOL ) 0 ); } + + if ( hb_comp_iWarnings >= 3 ) + { + PVAR pMemVar = pFunc->pMemvars; + + while( pMemVar ) + if( strcmp( pMemVar->szName, pVar->szName ) == 0 ) + break; + else + pMemVar = pMemVar->pNext; + + /* Not declared as memvar. */ + if( pMemVar == NULL ) + { + /* add this variable to the list of PRIVATE variables. */ + if( ! pFunc->pPrivates ) + pFunc->pPrivates = pVar; + else + { + pLastVar = pFunc->pPrivates; + + while( pLastVar->pNext ) + pLastVar = pLastVar->pNext; + + pLastVar->pNext = pVar; + } + //printf( "\nAdded Private: %s Type %c\n", pVar->szName, pVar->cType ); + } + } + break; + case VS_PRIVATE: { pSym = hb_compSymbolFind( szVarName, &wPos ); /* check if symbol exists already */ if( ! pSym ) pSym = hb_compSymbolAdd( hb_strdup( szVarName ), &wPos ); + pSym->cScope |= VS_MEMVAR; + + //printf( "\nAdded Symbol: %s Pos: %i\n", pSym->szName, wPos ); } + + if ( hb_comp_iWarnings >= 3 ) + { + PVAR pMemVar = pFunc->pMemvars; + + while( pMemVar ) + if( strcmp( pMemVar->szName, pVar->szName ) == 0 ) + break; + else + pMemVar = pMemVar->pNext; + + /* Not declared as memvar. */ + if( pMemVar == NULL ) + { + /* add this variable to the list of PRIVATE variables. */ + if( ! pFunc->pPrivates ) + pFunc->pPrivates = pVar; + else + { + pLastVar = pFunc->pPrivates; + + while( pLastVar->pNext ) + pLastVar = pLastVar->pNext; + + pLastVar->pNext = pVar; + } + //printf( "\nAdded Private: %s Type %c\n", pVar->szName, pVar->cType ); + } + } + break; + case VS_PUBLIC: { pSym = hb_compSymbolFind( szVarName, &wPos ); /* check if symbol exists already */ @@ -586,6 +658,7 @@ void hb_compVariableAdd( char * szVarName, BYTE cValueType ) pSym = hb_compSymbolAdd( hb_strdup( szVarName ), &wPos ); pSym->cScope |= VS_MEMVAR; } + break; } } @@ -782,6 +855,7 @@ static PFUNCTION hb_compFunctionNew( char * szName, HB_SYMBOLSCOPE cScope ) pFunc->pStatics = NULL; pFunc->pFields = NULL; pFunc->pMemvars = NULL; + pFunc->pPrivates = NULL; pFunc->pCode = NULL; pFunc->lPCodeSize = 0; pFunc->lPCodePos = 0; @@ -980,6 +1054,19 @@ PFUNCTION hb_compFunctionKill( PFUNCTION pFunc ) hb_xfree( ( void * ) pVar ); } + while( pFunc->pPrivates ) + { + pVar = pFunc->pPrivates; + pFunc->pPrivates = pVar->pNext; + + hb_xfree( ( void * ) pVar->szName ); + if( pVar->szAlias ) + { + hb_xfree( ( void * ) pVar->szAlias ); + } + hb_xfree( ( void * ) pVar ); + } + /* Release the NOOP array. */ if( pFunc->pNOOPs ) hb_xfree( ( void * ) pFunc->pNOOPs ); diff --git a/harbour/source/compiler/harbour.y b/harbour/source/compiler/harbour.y index 8e01a2c021..9ac2ad961e 100644 --- a/harbour/source/compiler/harbour.y +++ b/harbour/source/compiler/harbour.y @@ -1135,7 +1135,7 @@ FieldList : IdentName AsType { $$=hb_compFieldsCount(); hb_compVa MemvarDef : MEMVAR { hb_comp_iVarScope = VS_MEMVAR; } MemvarList Crlf ; -MemvarList : IdentName { hb_compVariableAdd( $1, ' ' ); } +MemvarList : IdentName AsType { hb_compVariableAdd( $1, ' ' ); } | MemvarList ',' IdentName { hb_compVariableAdd( $3, ' ' ); } ; diff --git a/harbour/source/compiler/hbpcode.c b/harbour/source/compiler/hbpcode.c index b648966d07..4e0d78d3f8 100644 --- a/harbour/source/compiler/hbpcode.c +++ b/harbour/source/compiler/hbpcode.c @@ -174,6 +174,25 @@ static BYTE s_pcode_len[] = { static BYTE * hb_comp_cParamTypes = NULL; static int hb_comp_iParamCount = -1; +static PVAR hb_compPrivateFind( char * szPrivateName ) +{ + PFUNCTION pFunc = hb_comp_functions.pLast; + PVAR pPrivate = NULL; + + if ( pFunc ) + pPrivate = pFunc->pPrivates; + + while ( pPrivate ) + { + if( ! strcmp( pPrivate->szName, szPrivateName ) ) + return pPrivate; + else + pPrivate = pPrivate->pNext; + + } + return NULL; +} + void hb_compPCodeEval( PFUNCTION pFunc, HB_PCODE_FUNC_PTR * pFunctions, void * cargo ) { ULONG ulPos = 0; @@ -212,8 +231,8 @@ void hb_compPCodeEval( PFUNCTION pFunc, HB_PCODE_FUNC_PTR * pFunctions, void * c void hb_compStrongType( int iSize ) { PFUNCTION pFunc = hb_comp_functions.pLast, pTmp; - PVAR pVar; - PCOMSYMBOL pSym; + PVAR pVar = NULL; + PCOMSYMBOL pSym = NULL; PCOMDECLARED pDeclared; ULONG ulPos = pFunc->lPCodePos - iSize; SHORT wVar = 0; @@ -221,7 +240,7 @@ void hb_compStrongType( int iSize ) BYTE bLast1, bLast2; /* Make sure we have enough stack space. */ - if ( pFunc->pStack == NULL ) + if ( ! pFunc->pStack ) pFunc->pStack = ( BYTE * ) hb_xgrab( pFunc->iStackSize += 16 ); else if ( pFunc->iStackSize - pFunc->iStackIndex < 4 ) pFunc->pStack = ( BYTE * ) hb_xrealloc( pFunc->pStack, pFunc->iStackSize += 16 ); @@ -967,41 +986,72 @@ void hb_compStrongType( int iSize ) /* Question use type "REFERENCE" or the base type of the var */ pFunc->pStack[ pFunc->iStackIndex++ ] = 'R'; - case HB_P_PUSHALIASEDFIELDNEAR : - case HB_P_PUSHFIELD : - case HB_P_PUSHALIASEDFIELD : - case HB_P_PUSHALIASEDVAR : case HB_P_PUSHVARIABLE : + /* Type can not be detrmined at compile time. */ + pFunc->pStack[ pFunc->iStackIndex++ ] = ' '; + break; + + case HB_P_PUSHALIASEDVAR : + /* TODO check what is aliased var. */ + pFunc->pStack[ pFunc->iStackIndex++ ] = ' '; + break; + + case HB_P_PUSHALIASEDFIELDNEAR : + pSym = hb_compSymbolGetPos( pFunc->pCode[ ulPos + 1 ] ); + /* Fall through - don't add break */ + + case HB_P_PUSHALIASEDFIELD : + case HB_P_PUSHFIELD : + if ( ! pSym ) + pSym = hb_compSymbolGetPos( pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256 ); + + if ( pSym->szName && pFunc->pFields ) + { + wVar = hb_compVariableGetPos( pFunc->pFields, pSym->szName ); + if ( wVar ) + pVar = hb_compVariableFind( pFunc->pFields, wVar ); + } + + /* Fall through - don't add break */ + case HB_P_PUSHMEMVAR : - if ( pFunc->pCode[ ulPos ] == HB_P_PUSHALIASEDFIELDNEAR ) - pSym = hb_compSymbolGetPos( pFunc->pCode[ ulPos + 1 ] ); - else + if ( ! pSym ) pSym = hb_compSymbolGetPos( pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256 ); if ( pSym ) { pFunc->pStack[ pFunc->iStackIndex++ ] = pSym->cType; - if ( pFunc->pCode[ ulPos ] == HB_P_PUSHMEMVAR && pSym->szName && pFunc->pMemvars ) + if ( pFunc->pCode[ ulPos ] == HB_P_PUSHMEMVAR && pSym->szName ) { - wVar = hb_compVariableGetPos( pFunc->pMemvars, pSym->szName ); + if ( pFunc->pMemvars ) + wVar = hb_compVariableGetPos( pFunc->pMemvars, pSym->szName ); + if ( wVar ) + pVar = hb_compVariableFind( pFunc->pMemvars, wVar ); + + if ( ! pVar ) + pVar = hb_compPrivateFind( pSym->szName ); + + if ( ( ! pVar ) && hb_comp_functions.pFirst->pMemvars ) { - pVar = hb_compVariableFind( pFunc->pMemvars, wVar ); - - if ( pVar ) - { - pFunc->pStack[ pFunc->iStackIndex - 1 ] = pVar->cType; - //printf( "\nPused: %s Type: %c SubType: %c\n", pVar->szName, pVar->cType, pVar->cType - 100 ); - - if ( ! ( pVar->iUsed & VU_INITIALIZED ) ) - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_NOT_INITIALIZED, pVar->szName, NULL ); - - /* Mark as used */ - pVar->iUsed |= VU_USED; - } + wVar = hb_compVariableGetPos( hb_comp_functions.pFirst->pMemvars, pSym->szName ); + if ( wVar ) + pVar = hb_compVariableFind( hb_comp_functions.pFirst->pMemvars, wVar ); } } + + if ( pVar ) + { + pFunc->pStack[ pFunc->iStackIndex - 1 ] = pVar->cType; + //printf( "\nPused: %s Type: %c SubType: %c\n", pVar->szName, pVar->cType, pVar->cType - 100 ); + + if ( ! ( pVar->iUsed & VU_INITIALIZED ) ) + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_NOT_INITIALIZED, pVar->szName, NULL ); + + /* Mark as used */ + pVar->iUsed |= VU_USED; + } } else pFunc->pStack[ pFunc->iStackIndex++ ] = ' '; @@ -1191,119 +1241,162 @@ void hb_compStrongType( int iSize ) pFunc->iStackIndex--; break; - case HB_P_POPALIASEDFIELDNEAR : - case HB_P_POPFIELD : - case HB_P_POPALIASEDFIELD : - /* TODO: Add support for FIELD declarations. */ - case HB_P_POPMEMVAR : case HB_P_POPVARIABLE : + pFunc->iStackIndex--; + break; + case HB_P_POPALIASEDVAR : + /* TODO: check what is aliasedvar? */ + pFunc->iStackIndex--; + break; + + case HB_P_POPALIASEDFIELDNEAR : + if ( pFunc->pCode[ ulPos ] == HB_P_POPALIASEDFIELDNEAR ) + { + wVar = ( SHORT ) pFunc->pCode[ ulPos + 1 ]; + pSym = hb_compSymbolGetPos( wVar ); + } + + case HB_P_POPALIASEDFIELD : + case HB_P_POPFIELD : + if ( pFunc->pCode[ ulPos ] == HB_P_POPFIELD || pFunc->pCode[ ulPos ] == HB_P_POPALIASEDFIELD ) + { + wVar = pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256; + pSym = hb_compSymbolGetPos( wVar ); + } + + //printf( "\nField: %s Pos: %i", pSym->szName, wVar ); + + /* For fall through as well */ + if ( pSym && pSym->szName && pFunc->pFields ) + { + wVar = hb_compVariableGetPos( pFunc->pFields, pSym->szName ); + if ( wVar ) + pVar = hb_compVariableFind( pFunc->pFields, wVar ); + } + + if ( ( ( ! wVar ) || ( ! pVar ) ) && pSym && pSym->szName && hb_comp_functions.pFirst->pFields ) + { + wVar = hb_compVariableGetPos( hb_comp_functions.pFirst->pFields, pSym->szName ); + pVar = hb_compVariableFind( hb_comp_functions.pFirst->pFields, wVar ); + } + + case HB_P_POPMEMVAR : pFunc->iStackIndex--; if ( pFunc->iStackIndex < 0 ) /* TODO Error Message after finalizing all possible pcodes. */ break; - if ( pFunc->pCode[ ulPos ] == HB_P_POPALIASEDFIELDNEAR ) - pSym = hb_compSymbolGetPos( pFunc->pCode[ ulPos + 1 ] ); - else - pSym = hb_compSymbolGetPos( pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256 ); + if ( pFunc->pCode[ ulPos ] == HB_P_POPMEMVAR ) + wVar = pFunc->pCode[ ulPos + 1 ] + pFunc->pCode[ ulPos + 2 ] * 256; + + if ( ! pSym ) + pSym = hb_compSymbolGetPos( wVar ); /* if ( pFunc->pMemvars ) - printf( "\nSymbol: %s Function: %s which HAS memvars\n", pSym->szName, pFunc->szName ); - else - printf( "\nSymbol: %s Function: %s which has NO memvars\n", pSym->szName, pFunc->szName ); + printf( "\nSymbol: %s #%li Function: %s which HAS memvars\n", pSym->szName, wVar, pFunc->szName ); + + if ( pFunc->pPrivates ) + printf( "\nSymbol: %s #%li Function: %s which HAS privates\n", pSym->szName, wVar, pFunc->szName ); */ if ( pSym ) { - if ( pFunc->pCode[ ulPos ] == HB_P_POPMEMVAR && pSym->szName && pFunc->pMemvars ) + if ( pFunc->pCode[ ulPos ] == HB_P_POPMEMVAR && pSym->szName ) { - wVar = hb_compVariableGetPos( pFunc->pMemvars, pSym->szName ); + if ( pFunc->pMemvars ) + wVar = hb_compVariableGetPos( pFunc->pMemvars, pSym->szName ); - //printf( "\nSymbol: %s Function: %s Variable #%li\n", pSym->szName, pFunc->szName, wVar ); + if ( wVar ) + pVar = hb_compVariableFind( pFunc->pMemvars, wVar ); - if ( wVar ) + if ( ! pVar ) + pVar = hb_compPrivateFind( pSym->szName ); + + if ( ( ! pVar ) && hb_comp_functions.pFirst->pMemvars ) + { + wVar = hb_compVariableGetPos( hb_comp_functions.pFirst->pMemvars, pSym->szName ); + if ( wVar ) + pVar = hb_compVariableFind( hb_comp_functions.pFirst->pMemvars, wVar ); + } + } + + if ( pVar ) + { + pVar->iUsed |= VU_INITIALIZED; + + //printf( "\nSymbol: %s Variable: %s Type: %c #%i Function: %s\n", pSym->szName, pVar->szName, pVar->cType, wVar, pFunc->szName ); + + /* Allow any type into a Variant, and record the subtype */ + if ( pVar->cType == ' ' || pVar->cType > 122 ) { - pVar = hb_compVariableFind( pFunc->pMemvars, wVar ); - - if ( pVar ) - { - pVar->iUsed |= VU_INITIALIZED; - - //printf( "\nSymbol: %s Variable: %s Type: %c #%i Function: %s\n", pSym->szName, pVar->szName, pVar->cType, wVar, pFunc->szName ); - - /* Allow any type into a Variant, and record the subtype */ - if ( pVar->cType == ' ' || pVar->cType > 122 ) - { - if ( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) - pVar->cType = ' '; - else if ( pFunc->pStack[ pFunc->iStackIndex ] > 122 ) - pVar->cType = pFunc->pStack[ pFunc->iStackIndex ]; - else - pVar->cType = pFunc->pStack[ pFunc->iStackIndex ] + 100; - - //printf( "\nSymbol: %s Variable: %s Assigned Type: \'%c\' SubType: %c #%i Stack: %i\n", pSym->szName, pVar->szName, pVar->cType, pVar->cType - 100, wVar, pFunc->iStackIndex ); - } - else - { - char szType[2]; - sprintf( szType, "%c", pVar->cType ); - - //printf( "Variable: %s Type: \'%c\' SubType: %c Comparing: %c Recorded: %s\n", pSym->szName, pVar->cType, pVar->cType - 100, pFunc->pStack[ pFunc->iStackIndex ], szType ); - - if ( pFunc->pStack[ pFunc->iStackIndex ] > 122 ) - pFunc->pStack[ pFunc->iStackIndex ] -= 100; - - if ( pFunc->pStack[ pFunc->iStackIndex ] == '-' ) - ; /* NIL allowed into all types */ - else if ( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, pVar->szName, szType ); - else if ( isupper( pVar->cType ) && pVar->cType != pFunc->pStack[ pFunc->iStackIndex ] ) - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_TYPE, pVar->szName, szType ); - else if ( islower( pVar->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, szType, NULL ); - else if ( islower( pVar->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == 'A' ) - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, szType, NULL ); - else if ( toupper( pVar->cType ) != pFunc->pStack[ pFunc->iStackIndex ] ) - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, szType, NULL ); - } - } + if ( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) + pVar->cType = ' '; + else if ( pFunc->pStack[ pFunc->iStackIndex ] > 122 ) + pVar->cType = pFunc->pStack[ pFunc->iStackIndex ]; else - { - /* Allow any type into a Variant, and record the subtype */ - if ( pSym->cType == ' ' || pSym->cType > 122 ) - { - if ( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) - pSym->cType = ' '; - else if ( pFunc->pStack[ pFunc->iStackIndex ] > 122 ) - pSym->cType = pFunc->pStack[ pFunc->iStackIndex ]; - else - pSym->cType = pFunc->pStack[ pFunc->iStackIndex ] + 100; - } - else - { - char szType[2]; - sprintf( szType, "%c", pSym->cType ); + pVar->cType = pFunc->pStack[ pFunc->iStackIndex ] + 100; - if ( pFunc->pStack[ pFunc->iStackIndex ] > 122 ) - pFunc->pStack[ pFunc->iStackIndex ] -= 100; + //printf( "\nSymbol: %s Variable: %s Assigned Type: \'%c\' SubType: %c #%i Stack: %i\n", pSym->szName, pVar->szName, pVar->cType, pVar->cType - 100, wVar, pFunc->iStackIndex ); + } + else + { + char szType[2]; + sprintf( szType, "%c", pVar->cType ); - if ( pFunc->pStack[ pFunc->iStackIndex ] == '-' ) - ; /* NIL allowed into all types */ - else if ( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, pSym->szName, szType ); - else if ( isupper( pSym->cType ) && pSym->cType != pFunc->pStack[ pFunc->iStackIndex ] ) - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_TYPE, pSym->szName, szType ); - else if ( islower( pSym->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, szType, NULL ); - else if ( islower( pSym->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == 'A' ) - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, szType, NULL ); - else if ( toupper( pSym->cType ) != pFunc->pStack[ pFunc->iStackIndex ] ) - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, szType, NULL ); - } - } + //printf( "Variable: %s Type: \'%c\' SubType: %c Comparing: %c Recorded: %s\n", pSym->szName, pVar->cType, pVar->cType - 100, pFunc->pStack[ pFunc->iStackIndex ], szType ); + + if ( pFunc->pStack[ pFunc->iStackIndex ] > 122 ) + pFunc->pStack[ pFunc->iStackIndex ] -= 100; + + if ( pFunc->pStack[ pFunc->iStackIndex ] == '-' ) + ; /* NIL allowed into all types */ + else if ( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, pVar->szName, szType ); + else if ( isupper( pVar->cType ) && pVar->cType != pFunc->pStack[ pFunc->iStackIndex ] ) + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_TYPE, pVar->szName, szType ); + else if ( islower( pVar->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, szType, NULL ); + else if ( islower( pVar->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == 'A' ) + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, szType, NULL ); + else if ( toupper( pVar->cType ) != pFunc->pStack[ pFunc->iStackIndex ] ) + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, szType, NULL ); + } + } + else + { + /* Allow any type into a Variant, and record the subtype */ + if ( pSym->cType == ' ' || pSym->cType > 122 ) + { + if ( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) + pSym->cType = ' '; + else if ( pFunc->pStack[ pFunc->iStackIndex ] > 122 ) + pSym->cType = pFunc->pStack[ pFunc->iStackIndex ]; + else + pSym->cType = pFunc->pStack[ pFunc->iStackIndex ] + 100; + } + else + { + char szType[2]; + sprintf( szType, "%c", pSym->cType ); + + if ( pFunc->pStack[ pFunc->iStackIndex ] > 122 ) + pFunc->pStack[ pFunc->iStackIndex ] -= 100; + + if ( pFunc->pStack[ pFunc->iStackIndex ] == '-' ) + ; /* NIL allowed into all types */ + else if ( pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_SUSPECT, pSym->szName, szType ); + else if ( isupper( pSym->cType ) && pSym->cType != pFunc->pStack[ pFunc->iStackIndex ] ) + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ASSIGN_TYPE, pSym->szName, szType ); + else if ( islower( pSym->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == ' ' ) + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, szType, NULL ); + else if ( islower( pSym->cType ) && pFunc->pStack[ pFunc->iStackIndex ] == 'A' ) + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_SUSPECT, szType, NULL ); + else if ( toupper( pSym->cType ) != pFunc->pStack[ pFunc->iStackIndex ] ) + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ARRAY_ASSIGN_TYPE, szType, NULL ); } } } diff --git a/harbour/tests/testwarn.prg b/harbour/tests/testwarn.prg index 70346f0aec..cc2c41b21a 100644 --- a/harbour/tests/testwarn.prg +++ b/harbour/tests/testwarn.prg @@ -61,6 +61,50 @@ DECLARE FUNCTION int( n AS NUMERIC ) AS NUMERIC DECLARE FUNCTION TEST AS NUMERIC +FIELD a AS CHAR +FIELD b AS CHAR + +MEMVAR Var1 AS CHAR + +PROCEDURE THEMAIN() + + FIELD b AS NUM + USE TEMP + + MEMVAR a AS NUM + MEMVAR Var1 AS NUM + + PRIVATE TEST AS CHAR + + M->TEST := "TEST" //OK - no warnings here + + a := 'A' + + b := 'a' + + Var1 := .f. + +RETURN + +PROCEDURE SOMEPROC() + + PRIVATE TEST AS NUMERIC + + M->TEST := 1 //incorrect warning is printed here + + FOR M->TEST := 1 TO M->TEST + 10 + ? "Incorrect warnings for FOR/NEXT" + NEXT + + REPLACE a WITH 1 + + M->public_var := 0 //core dumps (GPF) on Linux + + b := 0 + + Var1 := 1 + +RETURN PROC MAIN1() PRIVATE OTHER, TEST AS CHAR