fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

20000507-05:20 GMT-8 Ron Pinkas <Ron@Profit-Master.com>

Browse Source 
* 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".
This commit is contained in:
Ron Pinkas
2000-05-07 12:27:18 +00:00
parent 902545e657
commit 3e7718e76e
6 changed files with 362 additions and 119 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
harbour/ChangeLog
View File

@@ -1,3 +1,21 @@
20000507-05:20 GMT-8 Ron Pinkas <Ron@Profit-Master.com>
* 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 <rglab@imid.med.pl>
*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 <info@szelvesz.hu>

1
harbour/include/hbcomp.h
View File

@@ -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 */

89
harbour/source/compiler/harbour.c
View File

@@ -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 );

2
harbour/source/compiler/harbour.y
View File

@@ -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, ' ' ); }
;

325
harbour/source/compiler/hbpcode.c
View File

@@ -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 );
}
}
}

44
harbour/tests/testwarn.prg
View File

@@ -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