From 3f605c0795e0fd389f68cc99f385e4b28c3a6a0d Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Thu, 15 Jun 2006 16:11:27 +0000 Subject: [PATCH] 2006-06-15 18:10 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/rdd/usrrdd/usrrdd.c + added functions to set WorkArea flags USRRDD_SETBOF, USRRDD_SETEOF, USRRDD_SETFOUND, USRRDD_SETTOP, USRRDD_SETBOTTOM * harbour/include/hbapierr.h + added HB_ERR_ARGS_BASEPARAMS * harbour/source/rtl/errorapi.c ! check if ARGS passed to __ERRRT_BASE() and __ERRRT_SBASE() are valid to avoid possible GPF * replaced old hack with passing ARGS in array for some chosen errors by HB_ERR_ARGS_BASEPARAMS in hb_errRT_BASE and hb_errRT_BASE_SubstR - it was impossible to generate Clipper compatible error message * harbour/source/rtl/do.c * use HB_ERR_ARGS_BASEPARAMS * harbour/source/rtl/tobject.prg * assign SELF to ARGS of error object when EG_NO[VAR]METHOD RT error is generated - Clipper compatible. * harbour/source/vm/classes.c * added __msgNoMethod which is returned to hb_vmSend when object does not support requested message. This handler can display previous Harbour error message though now it's disabled and Clipper compatible error message is generated. I leave the decision to Harbour users which version of error message should be used. * changed __msgClsSel to return variable size array with only valid items If some code needs fixed size array then it will have to be updated * harbour/source/vm/hvm.c * generate Clipper compatible error messages for EG_NO[VAR]METHOD and EG_NOFUNC. Please do not change it. If you want previous Harbour error messages for EG_NO[VAR]METHOD then please change __msgNoMethod in classy.c * harbour/source/vm/arrays.c * minor modification --- harbour/ChangeLog | 40 +++++ harbour/include/hbapierr.h | 2 + harbour/source/rdd/usrrdd/usrrdd.c | 80 ++++++++++ harbour/source/rtl/do.c | 2 +- harbour/source/rtl/errorapi.c | 64 +++----- harbour/source/rtl/tobject.prg | 4 +- harbour/source/vm/arrays.c | 6 +- harbour/source/vm/classes.c | 231 ++++++++++++----------------- harbour/source/vm/hvm.c | 40 +---- 9 files changed, 255 insertions(+), 214 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 90f9b118b3..e2ea28d348 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,46 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ + ! 2907 MAIN_MISC(200) TFORNEXT( NIL, NIL, NIL ) + like in Clipper. I cannot uncomment it because it will break + backward binary compatibility so I'll do that when some modification + ! 2919 MAIN_MISC(212) TFORNEXT( NIL, NIL, NIL ) + Enabling this code clean the following errors reported by hbtest: + ! 2907 MAIN_MISC(200) TFORNEXT( NIL, NIL, NIL ) + Result: "E BASE 1074 Argument error <= A:2:U:NIL;U:NIL F:S" + Expected: "E BASE 1075 Argument error > A:2:U:NIL;U:NIL F:S" + ! 2919 MAIN_MISC(212) TFORNEXT( NIL, NIL, NIL ) + Result: "E BASE 1074 Argument error <= A:2:U:NIL;U:NIL F:S" + Expected: "E BASE 1075 Argument error > A:2:U:NIL;U:NIL F:S" + +2006-06-15 18:10 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + + added HB_ERR_ARGS_BASEPARAMS + + added functions to set WorkArea flags USRRDD_SETBOF, USRRDD_SETEOF, + USRRDD_SETFOUND, USRRDD_SETTOP, USRRDD_SETBOTTOM + + * harbour/include/hbapierr.h + + added HB_ERR_ARGS_BASEPARAMS + + * harbour/source/rtl/errorapi.c + ! check if ARGS passed to __ERRRT_BASE() and __ERRRT_SBASE() are + valid to avoid possible GPF + * replaced old hack with passing ARGS in array for some chosen errors + by HB_ERR_ARGS_BASEPARAMS in hb_errRT_BASE and hb_errRT_BASE_SubstR + - it was impossible to generate Clipper compatible error message + + * harbour/source/rtl/do.c + * use HB_ERR_ARGS_BASEPARAMS + + * harbour/source/rtl/tobject.prg + * assign SELF to ARGS of error object when EG_NO[VAR]METHOD RT error + is generated - Clipper compatible. + + * harbour/source/vm/classes.c + * added __msgNoMethod which is returned to hb_vmSend when object does + not support requested message. This handler can display previous + Harbour error message though now it's disabled and Clipper compatible + error message is generated. I leave the decision to Harbour users + which version of error message should be used. * changed __msgClsSel to return variable size array with only valid items If some code needs fixed size array then it will have to be updated diff --git a/harbour/include/hbapierr.h b/harbour/include/hbapierr.h index ca5c5fa167..398f73b406 100644 --- a/harbour/include/hbapierr.h +++ b/harbour/include/hbapierr.h @@ -93,6 +93,8 @@ HB_EXTERN_BEGIN #define HB_ERR_IE_UNREC_ERROR 1026 #define HB_ERR_IE_GENERIC 1027 +#define HB_ERR_ARGS_BASEPARAMS 0xFFFFFFFF + /* Standard API */ extern char * hb_errGetDescription ( PHB_ITEM pError ); diff --git a/harbour/source/rdd/usrrdd/usrrdd.c b/harbour/source/rdd/usrrdd/usrrdd.c index f5139411cc..713f041b88 100644 --- a/harbour/source/rdd/usrrdd/usrrdd.c +++ b/harbour/source/rdd/usrrdd/usrrdd.c @@ -2955,6 +2955,86 @@ HB_FUNC( USRRDD_AREARESULT ) } } +HB_FUNC( USRRDD_SETBOF ) +{ + AREAP pArea; + + if( ISLOG( 2 ) ) + { + if( ISNUM( 1 ) ) + pArea = hb_usrGetAreaPointer( hb_parni( 1 ) ); + else + pArea = ( AREAP ) hb_parptr( 1 ); + + if( pArea && pArea->rddID < s_uiUsrNodes && SELF_USRNODE( pArea ) ) + pArea->fBof = hb_parl( 2 ); + } +} + +HB_FUNC( USRRDD_SETEOF ) +{ + AREAP pArea; + + if( ISLOG( 2 ) ) + { + if( ISNUM( 1 ) ) + pArea = hb_usrGetAreaPointer( hb_parni( 1 ) ); + else + pArea = ( AREAP ) hb_parptr( 1 ); + + if( pArea && pArea->rddID < s_uiUsrNodes && SELF_USRNODE( pArea ) ) + pArea->fEof = hb_parl( 2 ); + } +} + +HB_FUNC( USRRDD_SETFOUND ) +{ + AREAP pArea; + + if( ISLOG( 2 ) ) + { + if( ISNUM( 1 ) ) + pArea = hb_usrGetAreaPointer( hb_parni( 1 ) ); + else + pArea = ( AREAP ) hb_parptr( 1 ); + + if( pArea && pArea->rddID < s_uiUsrNodes && SELF_USRNODE( pArea ) ) + pArea->fFound = hb_parl( 2 ); + } +} + +HB_FUNC( USRRDD_SETTOP ) +{ + AREAP pArea; + + if( ISLOG( 2 ) ) + { + if( ISNUM( 1 ) ) + pArea = hb_usrGetAreaPointer( hb_parni( 1 ) ); + else + pArea = ( AREAP ) hb_parptr( 1 ); + + if( pArea && pArea->rddID < s_uiUsrNodes && SELF_USRNODE( pArea ) ) + pArea->fTop = hb_parl( 2 ); + } +} + +HB_FUNC( USRRDD_SETBOTTOM ) +{ + AREAP pArea; + + if( ISLOG( 2 ) ) + { + if( ISNUM( 1 ) ) + pArea = hb_usrGetAreaPointer( hb_parni( 1 ) ); + else + pArea = ( AREAP ) hb_parptr( 1 ); + + if( pArea && pArea->rddID < s_uiUsrNodes && SELF_USRNODE( pArea ) ) + pArea->fBottom = hb_parl( 2 ); + } +} + static ERRCODE hb_usrErrorRT( AREAP pArea, USHORT uiGenCode, USHORT uiSubCode ) { PHB_ITEM pError; diff --git a/harbour/source/rtl/do.c b/harbour/source/rtl/do.c index bc1fe599b0..9523c09585 100644 --- a/harbour/source/rtl/do.c +++ b/harbour/source/rtl/do.c @@ -84,7 +84,7 @@ HB_FUNC( DO ) { PHB_ITEM pArgsArray = hb_arrayBaseParams(); - hb_errRT_BASE( EG_NOFUNC, 1001, NULL, hb_itemGetCPtr( pItem ), 1, pArgsArray ); + hb_errRT_BASE( EG_NOFUNC, 1001, NULL, hb_itemGetCPtr( pItem ), HB_ERR_ARGS_BASEPARAMS ); hb_itemRelease( pArgsArray ); return; } diff --git a/harbour/source/rtl/errorapi.c b/harbour/source/rtl/errorapi.c index cdb62cc1e4..9f63c7ea1b 100644 --- a/harbour/source/rtl/errorapi.c +++ b/harbour/source/rtl/errorapi.c @@ -757,7 +757,7 @@ HB_FUNC( __ERRRT_BASE ) ( ULONG ) hb_parnl( 2 ), hb_parc( 3 ), hb_parc( 4 ), - ( USHORT ) hb_parni( 5 ), + ( USHORT ) ( hb_pcount() > 5 && hb_parni( 5 ) > 0 ? 1 : 0 ), hb_param( 6, HB_IT_ANY ) ); } @@ -767,7 +767,7 @@ HB_FUNC( __ERRRT_SBASE ) ( ULONG ) hb_parnl( 2 ), hb_parc( 3 ), hb_parc( 4 ), - ( USHORT ) hb_parni( 5 ), + ( USHORT ) ( hb_pcount() > 5 && hb_parni( 5 ) > 0 ? 1 : 0 ), hb_param( 6, HB_IT_ANY ) ); } @@ -776,42 +776,34 @@ USHORT hb_errRT_BASE( ULONG ulGenCode, ULONG ulSubCode, const char * szDescripti USHORT uiAction; PHB_ITEM pError; - PHB_ITEM pArray, pArg; + PHB_ITEM pArray; va_list va; ULONG ulArgPos; BOOL bRelease = TRUE; /* Build the array from the passed arguments. */ - va_start( va, ulArgCount ); - if( ( ulSubCode == 1001 || ulSubCode == 1004 || ulSubCode == 1005 ) && ulArgCount == 1 ) - { - pArray = va_arg( va, PHB_ITEM ); - - if( HB_IS_ARRAY( pArray ) ) - { - bRelease = FALSE; - } - else - { - pArg = pArray; - pArray = hb_itemArrayNew( 1 ); - hb_itemArrayPut( pArray, 1, pArg ); - } - } - else if ( ulArgCount == 0 ) + if( ulArgCount == 0 ) { pArray = NULL; } + else if( ulArgCount == HB_ERR_ARGS_BASEPARAMS ) + { + if( hb_pcount() == 0 ) + pArray = NULL; + else + pArray = hb_arrayBaseParams(); + } else { pArray = hb_itemArrayNew( ulArgCount ); + va_start( va, ulArgCount ); for( ulArgPos = 1; ulArgPos <= ulArgCount; ulArgPos++ ) { hb_itemArrayPut( pArray, ulArgPos, va_arg( va, PHB_ITEM ) ); } + va_end( va ); } - va_end( va ); /* I replaced EF_CANRETRY with EF_NONE for Clipper compatibility * If it's wrong and I missed sth please fix me, Druzus. @@ -924,42 +916,34 @@ void hb_errRT_BASE_SubstR( ULONG ulGenCode, ULONG ulSubCode, const char * szDesc { PHB_ITEM pError; - PHB_ITEM pArray, pArg; + PHB_ITEM pArray; va_list va; ULONG ulArgPos; BOOL bRelease = TRUE; /* Build the array from the passed arguments. */ - va_start( va, ulArgCount ); - if( ( ulSubCode == 1001 || ulSubCode == 1004 || ulSubCode == 1005 ) && ulArgCount == 1 ) - { - pArray = va_arg( va, PHB_ITEM ); - - if( HB_IS_ARRAY( pArray ) ) - { - bRelease = FALSE; - } - else - { - pArg = pArray; - pArray = hb_itemArrayNew( 1 ); - hb_itemArrayPut( pArray, 1, pArg ); - } - } - else if ( ulArgCount == 0 ) + if( ulArgCount == 0 ) { pArray = NULL; } + else if( ulArgCount == HB_ERR_ARGS_BASEPARAMS ) + { + if( hb_pcount() == 0 ) + pArray = NULL; + else + pArray = hb_arrayBaseParams(); + } else { pArray = hb_itemArrayNew( ulArgCount ); + va_start( va, ulArgCount ); for( ulArgPos = 1; ulArgPos <= ulArgCount; ulArgPos++ ) { hb_itemArrayPut( pArray, ulArgPos, va_arg( va, PHB_ITEM ) ); } + va_end( va ); } - va_end( va ); pError = hb_errRT_New_Subst( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); diff --git a/harbour/source/rtl/tobject.prg b/harbour/source/rtl/tobject.prg index 3a6fbec5b6..6ab213d20e 100644 --- a/harbour/source/rtl/tobject.prg +++ b/harbour/source/rtl/tobject.prg @@ -173,9 +173,9 @@ static function HBObject_Error( cDesc, cClass, cMsg, nCode ) DEFAULT nCode TO 1004 IF nCode == 1005 - RETURN __errRT_SBASE( EG_NOVARMETHOD, 1005, cDesc, cClass + ":" + cMsg ) + RETURN __errRT_SBASE( EG_NOVARMETHOD, 1005, cDesc, cClass + ":" + cMsg, 1, QSelf() ) ENDIF - RETURN __errRT_SBASE( EG_NOMETHOD, nCode, cDesc, cClass + ":" + cMsg ) + RETURN __errRT_SBASE( EG_NOMETHOD, nCode, cDesc, cClass + ":" + cMsg, 1, QSelf() ) diff --git a/harbour/source/vm/arrays.c b/harbour/source/vm/arrays.c index 3be93db052..6d4ade00f1 100644 --- a/harbour/source/vm/arrays.c +++ b/harbour/source/vm/arrays.c @@ -599,16 +599,16 @@ ULONG hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG * if( HB_IS_BLOCK( pValue ) ) { - for( ulStart--; ulCount > 0; ulCount--, ulStart++ ) + for( --ulStart; ulCount > 0; --ulCount ) { hb_vmPushSymbol( &hb_symEval ); hb_vmPush( pValue ); hb_vmPush( pBaseArray->pItems + ulStart ); - hb_vmPushLong( ulStart + 1 ); + hb_vmPushLong( ++ulStart ); hb_vmDo( 2 ); if( HB_IS_LOGICAL( hb_stackReturnItem() ) && hb_stackReturnItem()->item.asLogical.value ) - return ulStart + 1; /* arrays start from 1 */ + return ulStart; /* arrays start from 1 */ } } else if( HB_IS_STRING( pValue ) ) diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index fde1dbfc22..dfebc2274d 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -198,6 +198,7 @@ static HARBOUR hb___msgSetShrData( void ); static HARBOUR hb___msgEvalInline( void ); static HARBOUR hb___msgVirtual( void ); static HARBOUR hb___msgSuper( void ); +static HARBOUR hb___msgNoMethod( void ); static HARBOUR hb___msgClsH( void ); static HARBOUR hb___msgClsName( void ); @@ -248,6 +249,7 @@ static HB_SYMB s___msgGetShrData = { "__msgGetShrData", {HB_FS_MESSAGE}, {hb___m static HB_SYMB s___msgEvalInline = { "__msgEvalInline", {HB_FS_MESSAGE}, {hb___msgEvalInline}, NULL }; static HB_SYMB s___msgVirtual = { "__msgVirtual", {HB_FS_MESSAGE}, {hb___msgVirtual}, NULL }; static HB_SYMB s___msgSuper = { "__msgSuper", {HB_FS_MESSAGE}, {hb___msgSuper}, NULL }; +static HB_SYMB s___msgNoMethod = { "__msgNoMethod", {HB_FS_MESSAGE}, {hb___msgNoMethod}, NULL }; static HB_SYMB s___msgClassName = { "CLASSNAME", {HB_FS_MESSAGE}, {hb___msgClsName}, NULL }; static HB_SYMB s___msgClassH = { "CLASSH", {HB_FS_MESSAGE}, {hb___msgClsH}, NULL }; @@ -748,17 +750,11 @@ char * hb_objGetClsName( PHB_ITEM pObject ) */ char * hb_objGetRealClsName( PHB_ITEM pObject, char * szName ) { - char * szClassName; - HB_TRACE(HB_TR_DEBUG, ("hb_objGetrealClsName(%p)", pObject)); if( HB_IS_ARRAY( pObject ) ) { - if( ! pObject->item.asArray.value->uiClass ) - { - szClassName = "ARRAY"; - } - else + if( pObject->item.asArray.value->uiClass ) { PHB_DYNS pMsg = hb_dynsymFindName( szName ); USHORT uiClass; @@ -796,75 +792,20 @@ char * hb_objGetRealClsName( PHB_ITEM pObject, char * szName ) uiClsTree=1; /* Flag Value */ break; } - - uiAt++; - - if( uiAt == uiMask ) - { + if( ++uiAt == uiMask ) uiAt = 0; - } } } - if (-- uiClsTree) - { uiCurCls = pObject->item.asArray.value->puiClsTree[uiClsTree] ; - } - } if( uiClass && uiClass <= s_uiClasses ) - { - szClassName = ( s_pClasses + uiClass - 1 )->szName; - } - else - { - szClassName = "UNKNOWN"; - } - } - } - else /* built in types */ - { - switch( pObject->type ) - { - case HB_IT_NIL: - szClassName = "NIL"; - break; - - case HB_IT_STRING: - case HB_IT_MEMO: - szClassName = "CHARACTER"; - break; - - case HB_IT_BLOCK: - szClassName = "BLOCK"; - break; - - case HB_IT_SYMBOL: - szClassName = "SYMBOL"; - break; - - case HB_IT_DATE: - szClassName = "DATE"; - break; - - case HB_IT_INTEGER: - case HB_IT_LONG: - case HB_IT_DOUBLE: - szClassName = "NUMERIC"; - break; - - case HB_IT_LOGICAL: - szClassName = "LOGICAL"; - break; - - default: - szClassName = "UNKNOWN"; - break; + return ( s_pClasses + uiClass - 1 )->szName; } } - return szClassName; + return hb_objGetClsName( pObject ); } static void hb_objPushSuperCast( PHB_ITEM pObject ) @@ -922,12 +863,17 @@ void hb_objPopSuperCast( PHB_ITEM pObject ) } } -static PHB_SYMB hb_objGetMthd( PHB_ITEM pObject, PHB_SYMB pMessage, BOOL * pfPopSuper ) +/* + * = hb_objGetMethod( , , ) + * + * Internal function to the function pointer of a message of an object + */ +PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage, BOOL * pfPopSuper ) { PCLASS pClass = NULL; PHB_DYNS pMsg; - HB_TRACE(HB_TR_DEBUG, ("hb_objGetMthd(%p, %p, %p)", pObject, pMessage, pfPopSuper)); + HB_TRACE(HB_TR_DEBUG, ("hb_objGetMethod(%p, %p, %p)", pObject, pMessage, pfPopSuper)); s_pMethod = NULL; if( pfPopSuper ) @@ -987,31 +933,27 @@ static PHB_SYMB hb_objGetMthd( PHB_ITEM pObject, PHB_SYMB pMessage, BOOL * pfPop else if( pMsg == s___msgClassSel.pDynSym ) return &s___msgClassSel; +/* else if( pMsg == s___msgEval.pDynSym ) return &s___msgEval; -/* + else if( pMsg == s___msgClsParent.pDynSym ) return &s___msgClsParent; else if( pMsg == s___msgClass.pDynSym ) return &s___msgClass; */ - else if( pClass && pfPopSuper ) - return pClass->pFunError; + else if( pfPopSuper ) + { + if( pClass && pClass->pFunError ) + return pClass->pFunError; + /* remove this line if you want default HVM error message */ + return &s___msgNoMethod; + } return NULL; } -/* - * = hb_objGetMethod( , , ) - * - * Internal function to the function pointer of a message of an object - */ -PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage, BOOL * pfPopSuper ) -{ - return hb_objGetMthd( (PHB_ITEM) pObject, (PHB_SYMB) pMessage, pfPopSuper ); -} - static PHB_SYMB hb_objFuncParam( int iParam ) { PHB_ITEM pItem = hb_param( iParam, HB_IT_SYMBOL ); @@ -1122,7 +1064,7 @@ BOOL hb_objHasMsg( PHB_ITEM pObject, char *szString ) if( pDynSym ) { - return hb_objGetMthd( pObject, pDynSym->pSymbol, NULL ) != NULL; + return hb_objGetMethod( pObject, pDynSym->pSymbol, NULL ) != NULL; } else { @@ -2165,20 +2107,21 @@ HB_FUNC( __CLASSSEL ) USHORT uiPos = 0; USHORT uiAt; - hb_itemRelease( pReturn ); - pReturn = hb_itemArrayNew( pClass->uiMethods ); - /* Create a transfer array */ + hb_arrayNew( pReturn, pClass->uiMethods ); /* Create a transfer array */ for( uiAt = 0; uiAt < uiLimit; uiAt++ ) { PHB_DYNS pMessage = ( PHB_DYNS ) pClass->pMethods[ uiAt ].pMessage; if( pMessage ) /* Hash Entry used ? */ { - PHB_ITEM pItem = hb_itemPutC( NULL, pMessage->pSymbol->szName ); - /* Add to array */ - hb_itemArrayPut( pReturn, ++uiPos, pItem ); - hb_itemRelease( pItem ); + PHB_ITEM pItem = hb_arrayGetItemPtr( pReturn, ++uiPos ); + if( pItem ) + hb_itemPutC( pItem, pMessage->pSymbol->szName ); + else + break; /* Generate internal error? */ } } + if( uiPos < pClass->uiMethods ) + hb_arraySize( pReturn, uiPos ); } hb_itemRelease( hb_itemReturn( pReturn ) ); @@ -2235,25 +2178,22 @@ HB_FUNC( __CLASSH ) */ HB_FUNC( __EVAL ) { - PHB_ITEM pObject = hb_itemParam( 1 ); + PHB_ITEM pObject = hb_param( 1, HB_IT_ANY ); USHORT uiPCount = hb_pcount(); - if( HB_IS_BLOCK( pObject ) ) + if( pObject && HB_IS_BLOCK( pObject ) ) { USHORT uiParam; hb_vmPushSymbol( &hb_symEval ); - hb_vmPush( pObject ); /* Push block */ - for( uiParam = 1; uiParam <= uiPCount; uiParam++ ) - hb_vmPush( hb_param( uiParam, HB_IT_ANY ) ); + hb_vmPush( pObject ); /* Push block */ + for( uiParam = 1; uiParam <= uiPCount; ++uiParam ) + hb_vmPush( hb_stackItemFromBase( uiParam ) ); - hb_vmDo( ( USHORT ) uiPCount ); /* Self is also an argument */ + hb_vmDo( ( USHORT ) uiPCount ); } else - hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, "EVAL", 0 ); - - hb_itemRelease( pObject ); - + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, "EVAL", pObject ? 1 : 0, pObject ); } /* ================================================ */ @@ -2295,60 +2235,48 @@ static HARBOUR hb___msgClsName( void ) */ static HARBOUR hb___msgClsSel( void ) { - HB_ITEM_PTR pSelf = hb_stackSelfItem(); - USHORT uiClass = ( USHORT ) ( HB_IS_ARRAY( pSelf ) - ? pSelf->item.asArray.value->uiClass : 0 ); - /* Get class word */ PHB_ITEM pReturn = hb_itemNew( NULL ); - USHORT nParam = HB_MSGLISTALL; - USHORT uiPCount = hb_pcount(); + PHB_ITEM pSelf = hb_stackSelfItem(); + USHORT uiClass; - if( uiPCount >= 1 ) - { - nParam = ( USHORT ) hb_parni( 1 ); - } + if( HB_IS_BYREF( pSelf ) ) + pSelf = hb_itemUnRef( pSelf ); - if( ( ! uiClass ) && HB_IS_BYREF( pSelf ) ) - { /* Variables by reference */ - PHB_ITEM pItemRef = hb_itemUnRef( pSelf ); - if( HB_IS_ARRAY( pItemRef ) ) - uiClass = pItemRef->item.asArray.value->uiClass; - } + uiClass = hb_objGetClass( pSelf ); if( uiClass && uiClass <= s_uiClasses ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); USHORT uiLimit = ( USHORT ) ( pClass->uiHashKey * BUCKET ); /* Number of Hash keys */ - USHORT uiPos = 0; - USHORT uiAt; + USHORT uiPos = 0, uiAt; + USHORT nParam; + nParam = hb_pcount() > 0 ? ( USHORT ) hb_parni( 1 ) : HB_MSGLISTALL; hb_arrayNew( pReturn, pClass->uiMethods ); for( uiAt = 0; uiAt < uiLimit && uiPos < pClass->uiMethods; uiAt++ ) { PHB_DYNS pMessage = ( PHB_DYNS ) pClass->pMethods[ uiAt ].pMessage; - s_pMethod = NULL; /* Current method pointer */ - if( pMessage ) /* Hash Entry used ? */ { - s_pMethod = pClass->pMethods + uiAt; + PMETHOD pMethod = pClass->pMethods + uiAt; if( ( nParam == HB_MSGLISTALL ) || ( nParam == HB_MSGLISTCLASS && ( - ( s_pMethod->pFuncSym == &s___msgSetClsData ) || - ( s_pMethod->pFuncSym == &s___msgGetClsData ) || - ( s_pMethod->pFuncSym == &s___msgSetShrData ) || - ( s_pMethod->pFuncSym == &s___msgGetShrData ) + ( pMethod->pFuncSym == &s___msgSetClsData ) || + ( pMethod->pFuncSym == &s___msgGetClsData ) || + ( pMethod->pFuncSym == &s___msgSetShrData ) || + ( pMethod->pFuncSym == &s___msgGetShrData ) ) ) || ( nParam == HB_MSGLISTPURE && !( - ( s_pMethod->pFuncSym == &s___msgSetClsData ) || - ( s_pMethod->pFuncSym == &s___msgGetClsData ) || - ( s_pMethod->pFuncSym == &s___msgSetShrData ) || - ( s_pMethod->pFuncSym == &s___msgGetShrData ) + ( pMethod->pFuncSym == &s___msgSetClsData ) || + ( pMethod->pFuncSym == &s___msgGetClsData ) || + ( pMethod->pFuncSym == &s___msgSetShrData ) || + ( pMethod->pFuncSym == &s___msgGetShrData ) ) ) ) @@ -2358,9 +2286,12 @@ static HARBOUR hb___msgClsSel( void ) } } } + if( uiPos < pClass->uiMethods ) + hb_arraySize( pReturn, uiPos ); + hb_itemRelease( hb_itemReturn( pReturn ) ); } - - hb_itemRelease( hb_itemReturn( pReturn ) ); + else + hb_ret(); } #if 0 @@ -2450,20 +2381,52 @@ static HARBOUR hb___msgEvalInline( void ) static HARBOUR hb___msgEval( void ) { HB_ITEM_PTR pSelf = hb_stackSelfItem(); + if( HB_IS_BLOCK( pSelf ) ) { USHORT uiParam; - USHORT uiPCount=hb_pcount(); + USHORT uiPCount = hb_pcount(); hb_vmPushSymbol( &hb_symEval ); - hb_vmPush( pSelf ); /* Push block */ + hb_vmPush( pSelf ); for( uiParam = 1; uiParam <= uiPCount; uiParam++ ) - hb_vmPush( hb_param( uiParam, HB_IT_ANY ) ); + hb_vmPush( hb_stackItemFromBase( uiParam ) ); - hb_vmDo( ( USHORT ) uiPCount ); /* Self is also an argument */ + hb_vmDo( ( USHORT ) uiPCount ); } else - hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, "EVAL", 0 ); + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, "EVAL", 1, pSelf ); +} + +/* + * __msgNoMethod() + * + * Internal function for generating error when not existing message is sent + */ +static HARBOUR hb___msgNoMethod( void ) +{ + PHB_ITEM pSelf = hb_stackSelfItem(); + PHB_SYMB pSym = hb_itemGetSymbol( hb_stackBaseItem() ); + +#if 1 /* Clipper compatible error message */ + if( pSym->szName[ 0 ] == '_' ) + hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, pSelf ); + else + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, pSelf ); +#else + char szDesc[ 128 ]; + + if( pSym->szName[ 0 ] == '_' ) + { + sprintf( szDesc, "Class: '%s' has no property", hb_objGetClsName( pSelf ) ); + hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, szDesc, pSym->szName + 1, HB_ERR_ARGS_BASEPARAMS ); + } + else + { + sprintf( szDesc, "Class: '%s' has no exported method", hb_objGetClsName( pSelf ) ); + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, szDesc, pSym->szName, HB_ERR_ARGS_BASEPARAMS ); + } +#endif } /* diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 1d2ae0bef2..e09bbc2f7c 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -3224,7 +3224,6 @@ static void hb_vmEnumNext( void ) for( i = ( int ) hb_stackItemFromTop( -2 )->item.asLong.value; i > 0; --i ) { -// pEnum = hb_itemUnRefRefer( hb_stackItemFromTop( -( i << 1 ) - 1 ) ); pEnum = hb_itemUnRefOnce( hb_stackItemFromTop( -( i << 1 ) - 1 ) ); if( HB_IS_ARRAY( pEnum->item.asEnum.basePtr ) ) { @@ -3263,7 +3262,6 @@ static void hb_vmEnumPrev( void ) for( i = hb_stackItemFromTop( -2 )->item.asLong.value; i > 0; --i ) { -// pEnum = hb_itemUnRefRefer( hb_stackItemFromTop( -( i << 1 ) - 1 ) ); pEnum = hb_itemUnRefOnce( hb_stackItemFromTop( -( i << 1 ) - 1 ) ); if( HB_IS_ARRAY( pEnum->item.asEnum.basePtr ) ) { @@ -3931,15 +3929,9 @@ HB_EXPORT void hb_vmDo( USHORT uiParams ) #endif } else if( pSym->szName[ 0 ] == '_' ) - { - hb_vmArrayGen( uiParams ); - hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, hb_stackItemFromTop( -1 ) ); - } + hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, pSelf ); else - { - hb_vmArrayGen( uiParams ); - hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, hb_stackItemFromTop( -1 ) ); - } + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, pSelf ); if( lPopSuper ) hb_objPopSuperCast( pSelf ); @@ -3973,13 +3965,7 @@ HB_EXPORT void hb_vmDo( USHORT uiParams ) #endif } else - { - /* Attempt to call an undefined function - * - generate unrecoverable runtime error - */ - hb_vmArrayGen( uiParams ); - hb_errRT_BASE_SubstR( EG_NOFUNC, 1001, NULL, pSym->szName, 1, hb_stackItemFromTop( -1 ) ); - } + hb_errRT_BASE_SubstR( EG_NOFUNC, 1001, NULL, pSym->szName, HB_ERR_ARGS_BASEPARAMS ); } if( s_bDebugging ) @@ -4039,7 +4025,6 @@ HB_EXPORT void hb_vmSend( USHORT uiParams ) { /* method of enumerator variable from FOR EACH statement */ - //HB_ITEM_PTR pEnum = hb_itemUnRefRefer( pSelf ); HB_ITEM_PTR pEnum = hb_itemUnRefOnce( pSelf ); if( HB_IS_ENUM( pEnum ) ) @@ -4089,23 +4074,10 @@ HB_EXPORT void hb_vmSend( USHORT uiParams ) hb_mthAddTime( pMethod, clock() - ulClock ); #endif } + else if( pSym->szName[ 0 ] == '_' ) + hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, pSelf ); else - { - char sDesc[128]; - - if( pSym->szName[ 0 ] == '_' ) - { - sprintf( (char *) sDesc, "Class: '%s' has no property", hb_objGetClsName( pSelf ) ); - hb_vmArrayGen( uiParams ); - hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, (char *) sDesc, pSym->szName + 1, 1, hb_stackItemFromTop( -1 ) ); - } - else - { - sprintf( (char *) sDesc, "Class: '%s' has no exported method", hb_objGetClsName( pSelf ) ); - hb_vmArrayGen( uiParams ); - hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, (char *) sDesc, pSym->szName, 1, hb_stackItemFromTop( -1 ) ); - } - } + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, pSelf ); if( lPopSuper ) hb_objPopSuperCast( pSelf );