diff --git a/harbour/ChangeLog b/harbour/ChangeLog index d8325158fd..0589d38961 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,32 @@ +20000522-06:15 GMT-8 Ron Pinkas + + * source/compiler/harbour.l + + Added "as structure", "as stru", "as array of structure", "as array of stru" + + * source/compiler/hbpcode.c + * Improved some logic in hb_StrongType() + + * source/vm/hvm.c + ! Corrected startup symbol when having to use Main() as per Ryszard. + + * source/pp/pptable.c + + Added the equivalent of: + #COMMANDS STRUCTURE AS [, AS ] => ; + STATIC __ := {|| IF( __ == NIL, , ) , HB_Structure( <"StruName">, { <"Var1"> [, <"VarN">] } )} ;; + DECLARE AS [ AS ] ;; + #TRANSLATE AS NEW => AS CLASS := ( Eval( __ ), HB_Structure( ) ) + + #TRANSLATE AS NEW => AS CLASS := ():New() + + * source/rtl/tclass.prg + + Added Function HB_Structure() ( Fully Declared! ) This function is used internally, but may be freely called from Clipper level. + It Aceepts Parameter 1 Structure Name, and optional parameter 2, as array of structure variable names. + If called with 2nd parameter, returns NIL (just creates the new Structure), if called with just parameter 1, it returns + new instance of defined structure. + + + tests\teststru.prg + + Added demo for new structure syntax + 20000522-01:51 DST Paul Tucker * include/hbcomp.h * adjust declaration of COMCLASS and COMDECLARE diff --git a/harbour/source/compiler/harbour.l b/harbour/source/compiler/harbour.l index 4e960ac5dc..2a9fa12b75 100644 --- a/harbour/source/compiler/harbour.l +++ b/harbour/source/compiler/harbour.l @@ -1439,6 +1439,8 @@ Separator {SpaceTab} "as character" { return AS_CHARACTER; } "as string" { return AS_CHARACTER; } "as class" { return AS_CLASS; } +"as stru" { return AS_CLASS; } +"as structure" { return AS_CLASS; } "as date" { return AS_DATE; } "as logical" { return AS_LOGICAL; } "as bool" { return AS_LOGICAL; } @@ -1458,6 +1460,8 @@ Separator {SpaceTab} "as array of character" { return AS_CHARACTER_ARRAY; } "as array of string" { return AS_CHARACTER_ARRAY; } "as array of class" { return AS_CLASS_ARRAY; } +"as array of stru" { return AS_CLASS_ARRAY; } +"as array of structure" { return AS_CLASS_ARRAY; } "as array of date" { return AS_DATE_ARRAY; } "as array of logical" { return AS_LOGICAL_ARRAY; } "as array of bool" { return AS_LOGICAL_ARRAY; } diff --git a/harbour/source/compiler/hbpcode.c b/harbour/source/compiler/hbpcode.c index 6c4ba4138e..3c87a22294 100644 --- a/harbour/source/compiler/hbpcode.c +++ b/harbour/source/compiler/hbpcode.c @@ -444,7 +444,10 @@ void hb_compStrongType( int iSize ) /*printf( "\nMethod: %s of Class: %s Parameters: %i\n", pSym->szName, pFunc->pStackClasses[ pFunc->iStackClasses - 1 ]->szName, pFunc->pStackFunctions[ pFunc->iStackFunctions - 1 ]->iParamCount );*/ if ( pFunc->pStackFunctions[ pFunc->iStackFunctions - 1 ] == NULL ) - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_MESSAGE_NOT_FOUND, pSym->szName, pFunc->pStackClasses[ pFunc->iStackClasses - 1 ]->szName ); + if ( pSym->szName[0] == '_' ) + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_MESSAGE_NOT_FOUND, &( pSym->szName[1] ), pFunc->pStackClasses[ pFunc->iStackClasses - 1 ]->szName ); + else + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_MESSAGE_NOT_FOUND, pSym->szName, pFunc->pStackClasses[ pFunc->iStackClasses - 1 ]->szName ); } else { @@ -1250,9 +1253,14 @@ void hb_compStrongType( int iSize ) pVar = hb_compVariableFind( pTmp->pStatics, wVar - pTmp->iStaticsBase ); + /* Will be pushed shortly. */ + pFunc->iStackIndex++; + if ( pVar ) { - /*printf( "\nStatic: %s Function: %s Found in: %s\n", pVar->szName, pFunc->szName, pTmp->szName );*/ + /* + printf( "\nStatic: %s Type: %c Function: %s Found in: %s\n", pVar->szName, pVar->cType, pFunc->szName, pTmp->szName ); + */ /* Only if "private" static, since global static may be intialized elsewhere. */ /* May have been initialized in previous execution of the function. @@ -1264,23 +1272,22 @@ void hb_compStrongType( int iSize ) /* Mark as used */ pVar->iUsed |= VU_USED; - if ( pVar->cType == 'S' && pFunc->iStackClasses < 8 ) + if ( toupper( pVar->cType ) == 'S' && pFunc->iStackClasses < 8 ) { /* Object of declared class */ pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pVar->pClass; - pFunc->pStack[ pFunc->iStackIndex++ ] = 'S'; } if ( pFunc->pCode[ ulPos ] == HB_P_PUSHSTATICREF ) - pFunc->pStack[ pFunc->iStackIndex++ ] = pVar->cType + VT_OFFSET_BYREF; + pFunc->pStack[ pFunc->iStackIndex - 1 ] = pVar->cType + VT_OFFSET_BYREF; else - pFunc->pStack[ pFunc->iStackIndex++ ] = pVar->cType; + pFunc->pStack[ pFunc->iStackIndex - 1 ] = pVar->cType; } else if ( pFunc->pCode[ ulPos ] == HB_P_PUSHSTATICREF ) - pFunc->pStack[ pFunc->iStackIndex++ ] = '@'; + pFunc->pStack[ pFunc->iStackIndex - 1 ] = '@'; else - pFunc->pStack[ pFunc->iStackIndex++ ] = ' '; + pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' '; break; @@ -1439,6 +1446,10 @@ void hb_compStrongType( int iSize ) { BYTE cVarType = pFunc->pStack[ pFunc->iStackIndex - 1 ]; + /* + printf( "\n Base Type: %c\n", cVarType ); + */ + if ( cVarType >= ( 'A' + VT_OFFSET_VARIANT ) ) cVarType -= VT_OFFSET_VARIANT; diff --git a/harbour/source/pp/pptable.c b/harbour/source/pp/pptable.c index 0cec3d805b..b412eb757a 100644 --- a/harbour/source/pp/pptable.c +++ b/harbour/source/pp/pptable.c @@ -389,6 +389,9 @@ static COMMANDS sC___236 = {0,"SET","INDEX TO [ \1A40 [, \1B40]] [\1C20 ADDITIVE static COMMANDS sC___237 = {0,"SET","ORDER TO \1A00 [IN \1B40]","ordSetFocus( \1A00 [, \1B30] )",&sC___236 }; static COMMANDS sC___238 = {0,"SET","ORDER TO TAG \1A40 [IN \1B40]","ordSetFocus( \1A30 [, \1B30] )",&sC___237 }; static COMMANDS sC___239 = {0,"SET","ORDER TO","ordSetFocus(0)",&sC___238 }; +static COMMANDS sC___240 = {0,"STRUCTURE","\1A00 \1B00 AS \1C00 [, \1D00 AS \1E00 ]","STATIC __\1A00 := {|| IF(__\1A00 == NIL, , ) ,hb_structure( \1A20, { \1B20 [, \1D20] } )} ; DECLARE \1A00 \1B00 AS \1C00 [ \1D00 AS \1E00] ; #translate AS NEW \1A00 => AS CLASS \1A00 := ( Eval(__\1A00), hb_Structure( \1A20 ) )",&sC___239 }; -COMMANDS * hb_pp_topCommand = &sC___239; -COMMANDS * hb_pp_topTranslate = NULL; +static COMMANDS sT___1 = {0,"AS","NEW \1A00","AS CLASS \1A00 := \1A00():New()",NULL }; + +COMMANDS * hb_pp_topCommand = &sC___240; +COMMANDS * hb_pp_topTranslate = &sT___1; diff --git a/harbour/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index acd1273228..abac15d88f 100644 --- a/harbour/source/rtl/tclass.prg +++ b/harbour/source/rtl/tclass.prg @@ -41,6 +41,10 @@ * Support for inheritance * Support for default DATA values * + * Copyright 2000 Ron Pinkas + * + * HB_Structure() + * * See doc/license.txt for licensing terms. * */ @@ -286,3 +290,66 @@ STATIC FUNCTION SetType( cType ) RETURN NIL //----------------------------------------------------------------------------// + +Function HB_Structure( cStructureName AS Char, aMembers AS Array OF Char ) + + STRUCTURE HB_Structure cName AS Char, hId As Num + + DECLARE __ClsNew( ClassName AS Char, N As Num ) AS Num + DECLARE __ClsAddMsg( H AS Num, Data AS Char, Type As Num, ID As Num ) AS Num + DECLARE __ClsInst( H AS Num ) AS Structure HB_Structure + + LOCAL hStructure AS Num, nCounter AS Num, nMembers AS Num + + STATIC asStructures AS Array OF Structure HB_Structure := {} + + STATIC sStructure AS Stru HB_Structure + + LOCAL hSelf As Num + + cStructureName := Upper( cStructureName ) + + hStructure := aScan( asStructures, { |aStructure| aStructure:cName == cStructureName } ) + + IF aMembers == NIL + IF hStructure == 0 + //hb_Structure( cStructureName, {} ) + RETURN NIL //hb_Structure( cStructureName ) + ELSE + RETURN __ClsInst( asStructures[ hStructure ]:hId ) + ENDIF + ELSE + IF hStructure > 0 + // Duplicate declaration + RETURN NIL + ENDIF + ENDIF + + nMembers := Len( aMembers ) + + hStructure := __ClsNew( cStructureName, nMembers ) + + FOR nCounter := 1 TO nMembers + __clsAddMsg( hStructure, aMembers[nCounter], nCounter, 1 ) + __clsAddMsg( hStructure, '_' + aMembers[nCounter], nCounter, 1 ) + NEXT + + IF sStructure == NIL + hSelf := __ClsNew( "HB_Structure", 2 ) + + __clsAddMsg( hSelf, "cName", 1, 1 ) + __clsAddMsg( hSelf, "_cName", 1, 1 ) + __clsAddMsg( hSelf, "hID", 2, 1 ) + __clsAddMsg( hSelf, "_hID", 2, 1 ) + + sStructure := __ClsInst( hSelf ) + ENDIF + + sStructure:cName := cStructureName + sStructure:hId := hStructure + + aAdd( asStructures, sStructure ) + +RETURN NIL //__clsInst( hStructure ) + +//----------------------------------------------------------------------------// diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 0e237ca08b..9f1db2c1dd 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -4070,7 +4070,7 @@ void hb_vmProcessSymbols( PHB_SYMB pModuleSymbols, USHORT uiModuleSymbols ) /* m if( ( ! s_pSymStart ) && ( hSymScope & HB_FS_FIRST ) ) s_pSymStart = pModuleSymbols + ui; /* first public defined symbol to start execution */ - if( ( hSymScope == HB_FS_PUBLIC ) || ( hSymScope & ( HB_FS_MESSAGE | HB_FS_MEMVAR ) ) ) + if( ( hSymScope == HB_FS_PUBLIC ) || ( hSymScope & ( HB_FS_MESSAGE | HB_FS_MEMVAR | HB_FS_FIRST ) ) ) hb_dynsymNew( pModuleSymbols + ui ); } } diff --git a/harbour/tests/teststru.prg b/harbour/tests/teststru.prg new file mode 100644 index 0000000000..a29756869d --- /dev/null +++ b/harbour/tests/teststru.prg @@ -0,0 +1,14 @@ +STRUCTURE MyStruct Var1 As Char, Var2 As Num + +PROCEDURE MAIN() + + LOCAL sTest AS New MyStruct + + sTest:Var1 := 8 // Warning Here as Expected. + sTest:NoSuchVar := "Error" // Warning here as expected. + + sTest:Var1 := 'Working' // No problem here. + + ? sTest:Var1 // Np Problem here. + +RETURN diff --git a/harbour/tests/testwarn.prg b/harbour/tests/testwarn.prg index 0f826bb8e5..f18b846e03 100644 --- a/harbour/tests/testwarn.prg +++ b/harbour/tests/testwarn.prg @@ -6,7 +6,6 @@ #ifdef __HARBOUR__ #pragma -es0 #else - #TRANSLATE AS ARRAY [OF ] => #TRANSLATE AS CHAR =>