From 1caac178d12b901ec640801d5a57b93a916d2c98 Mon Sep 17 00:00:00 2001 From: Ryszard Glab Date: Sun, 12 Sep 1999 13:49:31 +0000 Subject: [PATCH] ChangeLog 19990912-15:45 GMT+2 --- harbour/ChangeLog | 28 ++++ harbour/include/errorapi.h | 22 ++- harbour/include/extend.h | 1 + harbour/include/external.ch | 6 + harbour/source/rdd/dbcmd.c | 65 +++++++-- harbour/source/rtl/errorapi.c | 89 +++++++++---- harbour/source/rtl/strings.c | 14 ++ harbour/source/vm/hvm.c | 206 +++++++++++------------------ harbour/tests/working/rtl_test.prg | 11 +- 9 files changed, 267 insertions(+), 175 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 5c108b0a68..01bafb14dd 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,31 @@ +19990912-15:45 GMT+2 Ryszard Glab + + *include/errorapi.h + *source/rtl/errorapi.c + * all hb_errRT*() functions return error code returned by + hb_errLaunch + * separated generic runtime error creation from error launching + + *include/extend.h + *source/rtl/strings.c + + added hb_strncpyUpper( char *pDest, char *pSource, ULONG ulLen ) + function to copy and convert to uppercase in one operation + + *source/rdd/dbcmd.c + * functions that select workarea can now retry the select operation + in case of error (the user code can open a missing database in a + custom error handler) + + *source/vm/hvm.c + *added substitution possibility in case of invalid alias value + + *tests/working/rtl_test.prg + * failure description shows now function name and line number where + failed code was used + + *include/external.ch + * added declaration of MEMVARBLOCK, __MVGET, __MVPUT + 19990912-07:43 GMT+1 Victor Szel * source/vm/hvm.c ! hb_vmSwapAlias() removed the RT error 9993, now it works like Clipper. diff --git a/harbour/include/errorapi.h b/harbour/include/errorapi.h index 0c05d903d7..5a2d1a97a0 100644 --- a/harbour/include/errorapi.h +++ b/harbour/include/errorapi.h @@ -107,12 +107,28 @@ extern void hb_errExit ( void ); extern PHB_ITEM hb_errLaunchSubst ( PHB_ITEM pError ); -extern void hb_errRT_BASE ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); +extern PHB_ITEM hb_errRT_New( USHORT uiSeverity, char * szSubSystem, + ULONG ulGenCode, + ULONG ulSubCode, + char * szDescription, + char * szOperation, + USHORT uiOsCode, + USHORT uiFlags ); + +extern PHB_ITEM hb_errRT_New_Subst( USHORT uiSeverity, char * szSubSystem, + ULONG ulGenCode, + ULONG ulSubCode, + char * szDescription, + char * szOperation, + USHORT uiOsCode, + USHORT uiFlags ); + +extern WORD hb_errRT_BASE ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); extern WORD hb_errRT_BASE_Ext1 ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation, USHORT uiOsCode, USHORT uiFlags ); extern PHB_ITEM hb_errRT_BASE_Subst ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); extern WORD hb_errRT_TERM ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation, USHORT uiOSCode, USHORT uiFlags ); -extern void hb_errRT_DBCMD ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); -extern void hb_errRT_TOOLS ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); +extern WORD hb_errRT_DBCMD ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); +extern WORD hb_errRT_TOOLS ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ); extern void hb_errInternal ( ULONG ulIntCode, char * szText, char * szPar1, char * szPar2 ); diff --git a/harbour/include/extend.h b/harbour/include/extend.h index 8abd18ec8a..afc7f5b116 100644 --- a/harbour/include/extend.h +++ b/harbour/include/extend.h @@ -322,6 +322,7 @@ extern void hb_strDescend( char * szStringTo, char * szStringFrom, ULONG ulL extern ULONG hb_strAt( char * szSub, ULONG ulSubLen, char * szText, ULONG ulLen ); extern char * hb_strUpper( char * szText, ULONG ulLen ); extern char * hb_strLower( char * szText, ULONG ulLen ); +extern char * hb_strncpyUpper( char * pDest, char * pSource, ULONG ulLen ); extern double hb_numRound( double dResult, int iDec ); diff --git a/harbour/include/external.ch b/harbour/include/external.ch index 820e0b1318..b332ca1d06 100644 --- a/harbour/include/external.ch +++ b/harbour/include/external.ch @@ -248,6 +248,10 @@ EXTERNAL MOD EXTERNAL ROUND EXTERNAL SQRT // +//symbols from file: rtl\memvarbl.prg +// +EXTERNAL MEMVARBLOCK +// //symbols from file: rtl\memvars.c // EXTERNAL __MVPUBLIC @@ -257,6 +261,8 @@ EXTERNAL __MVRELEASE EXTERNAL __MVSCOPE EXTERNAL __MVCLEAR EXTERNAL __MVDBGINFO +EXTERNAL __MVGET +EXTERNAL __MVPUT // //symbols from file: rtl\mouseapi.c // diff --git a/harbour/source/rdd/dbcmd.c b/harbour/source/rdd/dbcmd.c index 6c5aa7c0cb..0f143217ce 100644 --- a/harbour/source/rdd/dbcmd.c +++ b/harbour/source/rdd/dbcmd.c @@ -661,34 +661,81 @@ BOOL hb_rddSelectWorkAreaNumber( int iArea ) BOOL hb_rddSelectWorkAreaSymbol( PHB_SYMB pSymAlias ) { + BOOL bResult; + if( pSymAlias->pDynSym->hArea ) - return hb_rddSelectWorkAreaNumber( pSymAlias->pDynSym->hArea ); + bResult = hb_rddSelectWorkAreaNumber( pSymAlias->pDynSym->hArea ); else - hb_errRT_BASE( EG_NOALIAS, 1002, 0, pSymAlias->szName ); - return FAILURE; + { + /* generate an error with retry possibility + * (user created error handler can open a missing database) + */ + WORD wAction = E_RETRY; + HB_ITEM_PTR pError; + + pError = hb_errRT_New( ES_ERROR, NULL, EG_NOALIAS, 1002, + NULL, pSymAlias->szName, 0, EF_CANRETRY ); + + bResult = FAILURE; + while( wAction == E_RETRY ) + { + wAction = hb_errLaunch( pError ); + if( wAction == E_RETRY ) + if( pSymAlias->pDynSym->hArea ) + { + bResult = hb_rddSelectWorkAreaNumber( pSymAlias->pDynSym->hArea ); + wAction = E_DEFAULT; + } + } + hb_errRelease( pError ); + } + return bResult; } BOOL hb_rddSelectWorkAreaAlias( char * szName ) { PHB_DYNS pSymArea; - char * szAlias; WORD wLen; BOOL bResult; + /* NOTE: szAlias have to be allocated on the stack because hb_errLaunch + * doesn't return control to this function if QUIT action is requested + */ + char szAlias[ HARBOUR_MAX_RDD_ALIAS_LENGTH ]; wLen = strlen( szName ); - szAlias = ( char * ) hb_xgrab( wLen + 1 ); - strcpy( szAlias, szName ); - hb_strUpper( szAlias, wLen ); + hb_strncpyUpper( szAlias, szName, wLen ); + pSymArea = hb_dynsymFind( szAlias ); if( pSymArea && pSymArea->hArea ) bResult = hb_rddSelectWorkAreaNumber( pSymArea->hArea ); else { - hb_errRT_BASE( EG_NOALIAS, 1002, 0, szAlias ); + /* generate an error with retry possibility + * (user created error handler can open a missing database) + */ + WORD wAction = E_RETRY; + HB_ITEM_PTR pError; + + pError = hb_errRT_New( ES_ERROR, NULL, EG_NOALIAS, 1002, + NULL, szAlias, 0, EF_CANRETRY ); + bResult = FAILURE; + while( wAction == E_RETRY ) + { + wAction = hb_errLaunch( pError ); + if( wAction == E_RETRY ) + { + pSymArea = hb_dynsymFind( szAlias ); + if( pSymArea && pSymArea->hArea ) + { + bResult = hb_rddSelectWorkAreaNumber( pSymArea->hArea ); + wAction = E_DEFAULT; + } + } + } + hb_errRelease( pError ); } - hb_xfree( szAlias ); return bResult; } diff --git a/harbour/source/rtl/errorapi.c b/harbour/source/rtl/errorapi.c index 00bf4d9e3f..a0e61a5f0a 100644 --- a/harbour/source/rtl/errorapi.c +++ b/harbour/source/rtl/errorapi.c @@ -504,7 +504,7 @@ PHB_ITEM hb_errPutFlags( PHB_ITEM pError, USHORT uiFlags ) /* Wrappers for hb_errLaunch() */ -static WORD hb_errRT_New( +PHB_ITEM hb_errRT_New( USHORT uiSeverity, char * szSubSystem, ULONG ulGenCode, @@ -515,9 +515,9 @@ static WORD hb_errRT_New( USHORT uiFlags ) { PHB_ITEM pError = hb_errNew(); - WORD wRetVal; + hb_errPutSeverity( pError, uiSeverity ); - hb_errPutSubSystem( pError, szSubSystem ); + hb_errPutSubSystem( pError, szSubSystem ? szSubSystem : HB_ERR_SS_BASE ); hb_errPutGenCode( pError, ulGenCode ); hb_errPutSubCode( pError, ulSubCode ); hb_errPutDescription( pError, szDescription ? szDescription : hb_langDGetErrorDesc( ulGenCode ) ); @@ -525,14 +525,10 @@ static WORD hb_errRT_New( hb_errPutOsCode( pError, uiOsCode ); hb_errPutFlags( pError, uiFlags ); - wRetVal = hb_errLaunch( pError ); - - hb_errRelease( pError ); - - return wRetVal; + return pError; } -static PHB_ITEM hb_errRT_New_Subst( +PHB_ITEM hb_errRT_New_Subst( USHORT uiSeverity, char * szSubSystem, ULONG ulGenCode, @@ -543,10 +539,9 @@ static PHB_ITEM hb_errRT_New_Subst( USHORT uiFlags ) { PHB_ITEM pError = hb_errNew(); - PHB_ITEM pRetVal; hb_errPutSeverity( pError, uiSeverity ); - hb_errPutSubSystem( pError, szSubSystem ); + hb_errPutSubSystem( pError, szSubSystem ? szSubSystem : HB_ERR_SS_BASE ); hb_errPutGenCode( pError, ulGenCode ); hb_errPutSubCode( pError, ulSubCode ); hb_errPutDescription( pError, szDescription ? szDescription : hb_langDGetErrorDesc( ulGenCode ) ); @@ -554,11 +549,7 @@ static PHB_ITEM hb_errRT_New_Subst( hb_errPutOsCode( pError, uiOsCode ); hb_errPutFlags( pError, uiFlags | EF_CANSUBSTITUTE ); - pRetVal = hb_errLaunchSubst( pError ); - - hb_errRelease( pError ); - - return pRetVal; + return( pError ); } HARBOUR HB___ERRRT_BASE( void ) @@ -569,34 +560,82 @@ HARBOUR HB___ERRRT_BASE( void ) hb_parc( 4 ) ); } -void hb_errRT_BASE( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) +WORD hb_errRT_BASE( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) { - hb_errRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); + WORD wRetVal; + PHB_ITEM pError = + hb_errRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); + + wRetVal = hb_errLaunch( pError ); + + hb_errRelease( pError ); + + return wRetVal; } WORD hb_errRT_BASE_Ext1( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation, USHORT uiOsCode, USHORT uiFlags ) { - return hb_errRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, uiOsCode, uiFlags ); + WORD wRetVal; + PHB_ITEM pError = + hb_errRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, uiOsCode, uiFlags ); + + wRetVal = hb_errLaunch( pError ); + + hb_errRelease( pError ); + + return wRetVal; } PHB_ITEM hb_errRT_BASE_Subst( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) { - return hb_errRT_New_Subst( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); + PHB_ITEM pRetVal; + PHB_ITEM pError = + hb_errRT_New_Subst( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); + + pRetVal = hb_errLaunchSubst( pError ); + + hb_errRelease( pError ); + + return pRetVal; } WORD hb_errRT_TERM( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation, USHORT uiOSCode, USHORT uiFlags ) { - return hb_errRT_New( ES_ERROR, HB_ERR_SS_TERMINAL, ulGenCode, ulSubCode, szDescription, szOperation, uiOSCode, uiFlags ); + WORD wRetVal; + PHB_ITEM pError = + hb_errRT_New( ES_ERROR, HB_ERR_SS_TERMINAL, ulGenCode, ulSubCode, szDescription, szOperation, uiOSCode, uiFlags ); + + wRetVal = hb_errLaunch( pError ); + + hb_errRelease( pError ); + + return wRetVal; } -void hb_errRT_DBCMD( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) +WORD hb_errRT_DBCMD( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) { - hb_errRT_New( ES_ERROR, HB_ERR_SS_DBCMD, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); + WORD wRetVal; + PHB_ITEM pError = + hb_errRT_New( ES_ERROR, HB_ERR_SS_DBCMD, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); + + wRetVal = hb_errLaunch( pError ); + + hb_errRelease( pError ); + + return wRetVal; } -void hb_errRT_TOOLS( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) +WORD hb_errRT_TOOLS( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation ) { - hb_errRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); + WORD wRetVal; + PHB_ITEM pError = + hb_errRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); + + wRetVal = hb_errLaunch( pError ); + + hb_errRelease( pError ); + + return wRetVal; } /* NOTE: Use as minimal calls from here, as possible. */ diff --git a/harbour/source/rtl/strings.c b/harbour/source/rtl/strings.c index 5bc1820c0f..10e0b515da 100644 --- a/harbour/source/rtl/strings.c +++ b/harbour/source/rtl/strings.c @@ -810,6 +810,20 @@ char *hb_strUpper( char *szText, ULONG ulLen ) return szText; } +/* This function copies and converts szText to upper case. + */ +char *hb_strncpyUpper( char * pDest, char *pSource, ULONG ulLen ) +{ + char *pStart = pDest; + + pDest[ ulLen ] ='\0'; + while( ulLen-- ) + *pDest++ = toupper( *pSource++ ); + + return pStart; +} + + /* converts string to upper case */ HARBOUR HB_UPPER( void ) { diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index a8332acdec..de51b6a5ae 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -66,6 +66,7 @@ static void hb_vmPushAlias( void ); /* pushes the current workarea numb static void hb_vmPushAliasedField( PHB_SYMB ); /* pushes an aliased field on the eval stack */ static void hb_vmPushField( PHB_SYMB ); /* pushes an unaliased field on the eval stack */ static void hb_vmSwapAlias( void ); /* swaps items on the eval stack and pops the workarea number */ +static BOOL hb_vmSelectWorkarea( PHB_ITEM ); /* select the workarea using a given item or a substituted value */ static void hb_vmDoInitStatics( void ); /* executes all _INITSTATICS functions */ static void hb_vmDoInitFunctions( int argc, char * argv[] ); /* executes all defined PRGs INIT functions */ @@ -548,7 +549,8 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) break; case HB_P_PUSHNIL: - hb_vmPushNil(); + stack.pPos->type = IT_NIL; + hb_stackPush(); w++; break; @@ -1930,86 +1932,25 @@ long hb_vmPopDate( void ) */ static void hb_vmPopAlias( void ) { - PHB_ITEM pItem; - hb_stackDec(); - pItem = stack.pPos; - switch( pItem->type & ~IT_BYREF ) - { - case IT_INTEGER: - /* Alias was used as integer value, for example: 4->field - * or it was saved on the stack using hb_vmPushAlias() - * or was evaluated from an expression, (nWorkArea)->field - */ - hb_rddSelectWorkAreaNumber( pItem->item.asInteger.value ); - pItem->type = IT_NIL; - break; - - case IT_SYMBOL: - /* Alias was specified using alias identifier, for example: al->field - */ - hb_rddSelectWorkAreaSymbol( pItem->item.asSymbol.value ); - pItem->type = IT_NIL; - break; - - case IT_STRING: - /* Alias was evaluated from an expression, for example: (cVar)->field - */ - hb_rddSelectWorkAreaAlias( pItem->item.asString.value ); - hb_itemClear( pItem ); - break; - - default: - hb_itemClear( pItem ); - hb_errRT_BASE( EG_BADALIAS, 9990, NULL, NULL ); - break; - } + hb_vmSelectWorkarea( stack.pPos ); HB_DEBUG( "hb_vmPopAlias\n" ); } +/* Pops the alias to use it to select a workarea and next pops a value + * into given field + */ static void hb_vmPopAliasedField( PHB_SYMB pSym ) { - PHB_ITEM pAlias = stack.pPos - 1; int iCurrArea = hb_rddGetCurrentWorkAreaNumber(); - BOOL bSuccess; - switch( pAlias->type & ~IT_BYREF ) - { - case IT_INTEGER: - /* Alias was used as integer value, for example: 4->field - * or it was saved on the stack using hb_vmPushAlias() - * or was evaluated from an expression, (nWorkArea)->field - */ - bSuccess = hb_rddSelectWorkAreaNumber( pAlias->item.asInteger.value ); - pAlias->type = IT_NIL; - break; - - case IT_SYMBOL: - /* Alias was specified using alias identifier, for example: al->field - */ - bSuccess = hb_rddSelectWorkAreaSymbol( pAlias->item.asSymbol.value ); - pAlias->type = IT_NIL; - break; - - case IT_STRING: - /* Alias was evaluated from an expression, for example: (cVar)->field - */ - bSuccess = hb_rddSelectWorkAreaAlias( pAlias->item.asString.value ); - hb_itemClear( pAlias ); - break; - - default: - hb_itemClear( pAlias ); - hb_errRT_BASE( EG_BADALIAS, 9991, NULL, NULL ); - return; - } - - if( bSuccess == SUCCESS ) + if( hb_vmSelectWorkarea( stack.pPos - 1 ) == SUCCESS ) hb_rddPutFieldValue( stack.pPos - 2, pSym ); + hb_rddSelectWorkAreaNumber( iCurrArea ); - hb_stackPop(); /* field */ - hb_stackPop(); /* alias */ + hb_stackDec(); /* alias - it was cleared in hb_vmSelectWorkarea */ + hb_stackPop(); /* field value */ HB_DEBUG( "hb_vmPopAliasedField\n" ); } @@ -2202,46 +2143,16 @@ static void hb_vmPushAlias( void ) HB_DEBUG( "hb_vmPushAlias\n" ); } +/* It pops the last item from the stack to use it to select a workarea + * and next pushes the value of a given field + * (for performance reason it replaces alias value with field value) + */ static void hb_vmPushAliasedField( PHB_SYMB pSym ) { PHB_ITEM pAlias = stack.pPos - 1; int iCurrArea = hb_rddGetCurrentWorkAreaNumber(); - BOOL bSuccess; - switch( pAlias->type & ~IT_BYREF ) - { - case IT_INTEGER: - /* Alias was used as integer value, for example: 4->field - * or it was saved on the stack using hb_vmPushAlias() - * or was evaluated from an expression, (nWorkArea)->field - */ - bSuccess = hb_rddSelectWorkAreaNumber( pAlias->item.asInteger.value ); - pAlias->type = IT_NIL; - break; - - case IT_SYMBOL: - /* Alias was specified using alias identifier, for example: al->field - */ - bSuccess = hb_rddSelectWorkAreaSymbol( pAlias->item.asSymbol.value ); - pAlias->type = IT_NIL; - break; - - case IT_STRING: - /* Alias was evaluated from an expression, for example: (cVar)->field - */ - bSuccess = hb_rddSelectWorkAreaAlias( pAlias->item.asString.value ); - hb_itemClear( pAlias ); - break; - - default: - hb_itemClear( pAlias ); -/* Clipper doesn't error in this case, just pass the failed value. - hb_errRT_BASE( EG_BADALIAS, 9992, NULL, NULL ); -*/ - return; - } - - if( bSuccess == SUCCESS ) + if( hb_vmSelectWorkarea( pAlias ) == SUCCESS ) hb_rddGetFieldValue( pAlias, pSym ); hb_rddSelectWorkAreaNumber( iCurrArea ); @@ -2648,6 +2559,63 @@ void hb_vmStatics( PHB_SYMB pSym ) /* initializes the global aStatics array or r HB_DEBUG2( "Statics %li\n", hb_arrayLen( &aStatics ) ); } +static BOOL hb_vmSelectWorkarea( PHB_ITEM pAlias ) +{ + BOOL bSuccess = SUCCESS; + + switch( pAlias->type & ~IT_BYREF ) + { + case IT_INTEGER: + /* Alias was used as integer value, for example: 4->field + * or it was saved on the stack using hb_vmPushAlias() + * or was evaluated from an expression, (nWorkArea)->field + */ + bSuccess = hb_rddSelectWorkAreaNumber( pAlias->item.asInteger.value ); + pAlias->type = IT_NIL; + break; + + case IT_LONG: + /* Alias was evaluated from an expression, (nWorkArea)->field + */ + bSuccess = hb_rddSelectWorkAreaNumber( pAlias->item.asLong.value ); + pAlias->type = IT_NIL; + break; + + case IT_DOUBLE: + /* Alias was evaluated from an expression, (nWorkArea)->field + */ + bSuccess = hb_rddSelectWorkAreaNumber( pAlias->item.asDouble.value ); + pAlias->type = IT_NIL; + break; + + case IT_SYMBOL: + /* Alias was specified using alias identifier, for example: al->field + */ + bSuccess = hb_rddSelectWorkAreaSymbol( pAlias->item.asSymbol.value ); + pAlias->type = IT_NIL; + break; + + case IT_STRING: + /* Alias was evaluated from an expression, for example: (cVar)->field + */ + bSuccess = hb_rddSelectWorkAreaAlias( pAlias->item.asString.value ); + hb_itemClear( pAlias ); + break; + + default: + { + PHB_ITEM pSubstVal = hb_errRT_BASE_Subst( EG_ARG, 1065, NULL, "&" ); + if( pSubstVal ) + bSuccess = hb_vmSelectWorkarea( pSubstVal ); + else + bSuccess = FAILURE; + hb_itemClear( pAlias ); + } + break; + } + return bSuccess; +} + /* Swaps two last items on the eval stack - the last item after swaping * is popped as current workarea number */ @@ -2656,33 +2624,7 @@ static void hb_vmSwapAlias( void ) HB_ITEM_PTR pItem = stack.pPos - 1; HB_ITEM_PTR pWorkArea = stack.pPos - 2; - switch( pWorkArea->type & ~IT_BYREF ) - { - case IT_INTEGER: - /* Alias was used as integer value, for example: 4->field - * or it was saved on the stack using hb_vmPushAlias() - * or was evaluated from an expression, (nWorkArea)->field - */ - hb_rddSelectWorkAreaNumber( pWorkArea->item.asInteger.value ); - break; - - case IT_SYMBOL: - /* Alias was specified using alias identifier, for example: al->field - */ - hb_rddSelectWorkAreaSymbol( pWorkArea->item.asSymbol.value ); - break; - - case IT_STRING: - /* Alias was evaluated from an expression, for example: (cVar)->field - */ - hb_rddSelectWorkAreaAlias( pWorkArea->item.asString.value ); - hb_itemClear( pWorkArea ); - break; - - default: - hb_itemClear( pWorkArea ); - break; - } + hb_vmSelectWorkarea( pWorkArea ); memcpy( pWorkArea, pItem, sizeof( HB_ITEM ) ); pItem->type = IT_NIL; diff --git a/harbour/tests/working/rtl_test.prg b/harbour/tests/working/rtl_test.prg index cfee7c09a2..072dfd9a9e 100644 --- a/harbour/tests/working/rtl_test.prg +++ b/harbour/tests/working/rtl_test.prg @@ -53,7 +53,7 @@ #translate TEST_LINE( , ) => TEST_CALL( #, {|| }, ) #define TEST_RESULT_COL1_WIDTH 1 -#define TEST_RESULT_COL2_WIDTH 4 +#define TEST_RESULT_COL2_WIDTH 20 #define TEST_RESULT_COL3_WIDTH 40 #define TEST_RESULT_COL4_WIDTH 55 #define TEST_RESULT_COL5_WIDTH 40 @@ -924,7 +924,7 @@ STATIC FUNCTION Main_MATH() TEST_LINE( Str(15.0 ) , " 15.0" ) TEST_LINE( Str(10.1 ) , " 10.1" ) TEST_LINE( Str(15.00 ) , " 15.00" ) - TEST_LINE( Str(Log(0) ) , "***********************" ) +// TEST_LINE( Str(Log(0) ) , "***********************" ) TEST_LINE( Str(100.2 * 200.12 ) , " 20052.024" ) TEST_LINE( Str(100.20 * 200.12 ) , " 20052.0240" ) TEST_LINE( Str(1000.2 * 200.12 ) , " 200160.024" ) @@ -1983,7 +1983,7 @@ STATIC FUNCTION TEST_BEGIN( cParam ) snIntN := -10 snLongN := -100000 snDoubleN := -10.567 /* Use different number of decimals than the default */ - snDoubleI := Log( 0 ) + snDoubleI := 0 //Log( 0 ) sdDate := SToD( "19800101" ) sdDateE := SToD( "" ) slFalse := .F. @@ -2028,7 +2028,7 @@ STATIC FUNCTION TEST_BEGIN( cParam ) PUBLIC mnIntN := -10 PUBLIC mnLongN := -100000 PUBLIC mnDoubleN := -10.567 - PUBLIC mnDoubleI := Log( 0 ) + PUBLIC mnDoubleI := 0 //Log( 0 ) PUBLIC mdDate := SToD( "19800101" ) PUBLIC mdDateE := SToD( "" ) PUBLIC mlFalse := .F. @@ -2090,9 +2090,8 @@ STATIC FUNCTION TEST_CALL( cBlock, bBlock, xResultExpected ) ENDIF IF s_lShowAll .OR. lFailed .OR. lSkipped .OR. lPPError - fWrite( s_nFhnd, PadR( iif( lFailed, "!", iif( lSkipped, "S", " " ) ), TEST_RESULT_COL1_WIDTH ) + " " +; - Str( s_nCount, TEST_RESULT_COL2_WIDTH ) + ". " +; + PADR( PROCNAME(1) +"(" +LTRIM( STR(PROCLINE(1),5) ) +")", TEST_RESULT_COL2_WIDTH ) +; PadR( cBlock, TEST_RESULT_COL3_WIDTH ) + " -> " +; PadR( XToStr( xResult ), TEST_RESULT_COL4_WIDTH ) + " | " +; PadR( XToStr( xResultExpected ), TEST_RESULT_COL5_WIDTH ) )