diff --git a/harbour/ChangeLog b/harbour/ChangeLog index d531907a27..d40a986658 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,39 @@ +19990905-17:48 GMT+1 Victor Szel + * source/rtl/dbf1.c + % Uses hb_itemPutN?Len() instead of hb_itemSetNLen(), so it's a bit + faster now. + * source/rtl/errorapi.c + % Now uses hb_itemDo() instead of the Eval API. Eight function calls + substituted with a single one. + * source/rtl/extend.c + + hb_retn?len() functions now make simple calls to hb_itemPutN?Len() + functions. + * source/rtl/itemapi.c + include/itemapi.h + + EVALINFO structure now has a Clipper compatible paramCount member. + ! hb_eval*() speed up a bit by using paramCount, and by assigning error + return value only on error. + ! hb_evalPutParam() now check if pItem is a NULL. + ! hb_evalRelease() now sets back the EVALINFO structure to an initial + state, just like Clipper. + + hb_itemDo() and hb_itemDoC() function added, they do the same as hb_eval() + but in a lot more convenient way. + + hb_itemPutNDLen(), hb_itemPutNILen(), hb_itemPutNLLen() functions added + to make to number lenght setting easier. + * source/rtl/do.c + ! DO() without any parameter caused a GPF. Fixed. + * tests/working/rtl_test.prg + + Alias tests enabled. Now an internal occurs in one of them, this will + need fixing. Some alias Pop/Push/Swap functions are not checking NULL + pointers and are not yet compatible with Clipper in strange situations. + + Fixed some result in == test with objects and arrays. Added some more + == tests. + * source/vm/hvm.c + ! Small correction in one debug message. + * source/vm/initsymb.c + + SETPOSBS added to the list. Since it's a native opcode in Clipper, it + always linked in by nature. + 19990905-02:47 EDT Paul Tucker * source/rtl/filesys.c * casts on access() and in HB_FILE diff --git a/harbour/include/itemapi.h b/harbour/include/itemapi.h index 589057d84d..d65f8ff77b 100644 --- a/harbour/include/itemapi.h +++ b/harbour/include/itemapi.h @@ -33,6 +33,7 @@ typedef struct { + USHORT paramCount; PHB_ITEM pItems[ HB_EVAL_PARAM_MAX_ + 1 ]; } EVALINFO, * PEVALINFO, * EVALINFO_PTR; @@ -41,6 +42,9 @@ extern BOOL hb_evalNew ( PEVALINFO pEvalInfo, PHB_ITEM pItem ); extern BOOL hb_evalPutParam ( PEVALINFO pEvalInfo, PHB_ITEM pItem ); extern BOOL hb_evalRelease ( PEVALINFO pEvalInfo ); +extern PHB_ITEM hb_itemDo ( PHB_ITEM pItem, USHORT uiPCount, ... ); +extern PHB_ITEM hb_itemDoC ( char * szFunc, USHORT uiPCount, ... ); + extern PHB_ITEM hb_itemArrayGet ( PHB_ITEM pArray, ULONG ulIndex ); extern PHB_ITEM hb_itemArrayNew ( ULONG ulLen ); extern PHB_ITEM hb_itemArrayPut ( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ); @@ -65,6 +69,9 @@ extern PHB_ITEM hb_itemPutL ( PHB_ITEM pItem, BOOL bValue ); extern PHB_ITEM hb_itemPutND ( PHB_ITEM pItem, double dNumber ); extern PHB_ITEM hb_itemPutNI ( PHB_ITEM pItem, int iNumber ); extern PHB_ITEM hb_itemPutNL ( PHB_ITEM pItem, long lNumber ); +extern PHB_ITEM hb_itemPutNDLen ( PHB_ITEM pItem, double dNumber, WORD wWidth, WORD wDecimal ); +extern PHB_ITEM hb_itemPutNILen ( PHB_ITEM pItem, int iNumber, WORD wWidth ); +extern PHB_ITEM hb_itemPutNLLen ( PHB_ITEM pItem, long lNumber, WORD wWidth ); extern BOOL hb_itemRelease ( PHB_ITEM pItem ); extern PHB_ITEM hb_itemReturn ( PHB_ITEM pItem ); extern ULONG hb_itemSize ( PHB_ITEM pItem ); diff --git a/harbour/source/rdd/dbf1.c b/harbour/source/rdd/dbf1.c index 7599be48a8..0b4eca44e6 100644 --- a/harbour/source/rdd/dbf1.c +++ b/harbour/source/rdd/dbf1.c @@ -117,7 +117,7 @@ static BOOL hb_nltoa( LONG lValue, char * szBuffer, USHORT uiLen ) { memset( szBuffer, ' ', uiLen ); return FALSE; - } + } uiLen--; for( iCount = 0; iCount < uiLen; iCount++ ) @@ -166,7 +166,7 @@ static BOOL hb_ndtoa( double dValue, char * szBuffer, USHORT uiLen, USHORT uiDec { memset( szBuffer, ' ', uiLen ); return FALSE; - } + } szEndChar = szBuffer[ uiLen ]; sprintf( szBuffer, "%*.*f", uiLen, uiDec, dValue ); szBuffer[ uiLen ] = szEndChar; @@ -628,7 +628,7 @@ static ERRCODE AddField( AREAP pArea, LPDBFIELDINFO pFieldInfo ) static ERRCODE Append( AREAP pArea, BOOL bUnLockAll ) { ULONG lRecCount, lRecNo; - + if( SELF_RECCOUNT( pArea, &lRecCount ) == FAILURE ) return FAILURE; @@ -815,10 +815,9 @@ static ERRCODE GetValue( AREAP pArea, USHORT uiIndex, PHB_ITEM pItem ) szEndChar = * ( szText + pField->uiLen ); * ( szText + pField->uiLen ) = '\0'; if( pField->uiDec ) - hb_itemPutND( pItem, atof( ( char * ) szText ) ); + hb_itemPutNDLen( pItem, atof( ( char * ) szText ), ( WORD ) pField->uiLen, ( WORD ) pField->uiDec ); else - hb_itemPutNL( pItem, atol( ( char * ) szText ) ); - hb_itemSetNLen( pItem, ( WORD ) pField->uiLen, ( WORD ) pField->uiDec ); + hb_itemPutNLLen( pItem, atol( ( char * ) szText ), ( WORD ) pField->uiLen ); * ( szText + pField->uiLen ) = szEndChar; break; @@ -844,7 +843,7 @@ static ERRCODE GetValue( AREAP pArea, USHORT uiIndex, PHB_ITEM pItem ) hb_itemPutC( pItem, "" ); break; } - + return SUCCESS; } @@ -872,7 +871,7 @@ static ERRCODE GetVarLen( AREAP pArea, USHORT uiIndex, ULONG * ulLen ) static ERRCODE GoBottom( AREAP pArea ) { ULONG lRecCount; - + if( SELF_RECCOUNT( pArea, &lRecCount ) == FAILURE ) return FAILURE; @@ -882,7 +881,7 @@ static ERRCODE GoBottom( AREAP pArea ) static ERRCODE GoTo( AREAP pArea, ULONG lRecNo ) { ULONG lRecCount; - + if( pArea->lpExtendInfo->fRecordChanged && !hb_dbfUpdateRecord(pArea, pArea->lpExtendInfo->lRecNo ) ) return FAILURE; @@ -1004,11 +1003,11 @@ static ERRCODE Open( AREAP pArea, LPDBOPENINFO pOpenInfo ) if( SUPER_OPEN( pArea, pOpenInfo ) == FAILURE ) return FAILURE; - + uiFlags = pOpenInfo->fReadonly ? FO_READ : FO_READWRITE; uiFlags |= pOpenInfo->fShared ? FO_DENYNONE : FO_EXCLUSIVE; pArea->lpFileInfo->hFile = hb_fsOpen( pOpenInfo->abName, uiFlags ); - + if( pArea->lpFileInfo->hFile == FS_ERROR ) { SELF_CLOSE( pArea ); @@ -1281,14 +1280,14 @@ static ERRCODE ReadDBHeader( AREAP pArea ) for( uiFields = 0; uiFields < uiDataLen; uiFields += 32 ) if( szBuffer[ uiFields ] == 0xD ) break; - + uiFields /= 32; if( ( uiDataLen / 32 ) < uiFields ) { hb_xfree( szBuffer ); return FAILURE; } - + pArea->lpExtendInfo->uiRecordLen = 1; SELF_SETFIELDEXTENT( pArea, uiFields ); pFieldInfo.typeExtended = 0; diff --git a/harbour/source/rtl/do.c b/harbour/source/rtl/do.c index 422c6a1665..486e129bc5 100644 --- a/harbour/source/rtl/do.c +++ b/harbour/source/rtl/do.c @@ -84,45 +84,53 @@ */ HARBOUR HB_DO( void ) { - PHB_ITEM pItem = hb_param( 1, IT_ANY ); + int iPCount = hb_pcount(); - if( IS_STRING( pItem ) ) + if( iPCount >= 1 ) { - PHB_DYNS pDynSym = hb_dynsymGet( pItem->item.asString.value ); + PHB_ITEM pItem = hb_param( 1, IT_ANY ); - if( pDynSym ) + if( IS_STRING( pItem ) ) + { + PHB_DYNS pDynSym = hb_dynsymGet( hb_itemGetCPtr( pItem ) ); + + if( pDynSym ) + { + int i; + + hb_vmPushSymbol( pDynSym->pSymbol ); + hb_vmPushNil(); + for( i = 2; i <= iPCount; i++ ) + hb_vmPush( hb_param( i, IT_ANY ) ); + hb_vmDo( iPCount - 1 ); + } + else + hb_errRT_BASE( EG_NOFUNC, 1001, NULL, pItem->item.asString.value ); + } + else if( IS_BLOCK( pItem ) ) { int i; - hb_vmPushSymbol( pDynSym->pSymbol ); - hb_vmPushNil(); - for( i = 2; i <= hb_pcount(); i++ ) + hb_vmPushSymbol( &symEval ); + hb_vmPush( pItem ); + for( i = 2; i <= iPCount; i++ ) hb_vmPush( hb_param( i, IT_ANY ) ); - hb_vmDo( hb_pcount() - 1 ); + hb_vmDo( iPCount - 1 ); + } + else if( IS_SYMBOL( pItem ) ) + { + int i; + + hb_vmPushSymbol( pItem->item.asSymbol.value ); + hb_vmPushNil(); + for( i = 2; i <= iPCount; i++ ) + hb_vmPush( hb_param( i, IT_ANY ) ); + hb_vmDo( iPCount - 1 ); } else - hb_errRT_BASE( EG_NOFUNC, 1001, NULL, pItem->item.asString.value ); - } - else if( IS_BLOCK( pItem ) ) - { - int i; - - hb_vmPushSymbol( &symEval ); - hb_vmPush( pItem ); - for( i = 2; i <= hb_pcount(); i++ ) - hb_vmPush( hb_param( i, IT_ANY ) ); - hb_vmDo( hb_pcount() - 1 ); - } - else if( IS_SYMBOL( pItem ) ) - { - int i; - - hb_vmPushSymbol( pItem->item.asSymbol.value ); - hb_vmPushNil(); - for( i = 2; i <= hb_pcount(); i++ ) - hb_vmPush( hb_param( i, IT_ANY ) ); - hb_vmDo( hb_pcount() - 1 ); + hb_errRT_BASE( EG_ARG, 3012, NULL, "DO" ); } else hb_errRT_BASE( EG_ARG, 3012, NULL, "DO" ); } + diff --git a/harbour/source/rtl/errorapi.c b/harbour/source/rtl/errorapi.c index 2e9de5fe8e..d4ca6e5daa 100644 --- a/harbour/source/rtl/errorapi.c +++ b/harbour/source/rtl/errorapi.c @@ -119,9 +119,6 @@ WORD hb_errLaunch( PHB_ITEM pError ) if( pError ) { - EVALINFO eval; - PHB_ITEM pBlock; - PHB_ITEM pObject; PHB_ITEM pResult; /* Check if we have a valid error handler */ @@ -134,21 +131,11 @@ WORD hb_errLaunch( PHB_ITEM pError ) if( s_iLaunchCount == HB_ERROR_LAUNCH_MAX ) hb_errInternal( 9999, "Too many recursive error handler calls", NULL, NULL ); - s_iLaunchCount++; - /* Launch the error handler: "lResult := EVAL( ErrorBlock(), oError )" */ - pBlock = hb_itemNew( NULL ); - pObject = hb_itemNew( NULL ); + s_iLaunchCount++; - hb_itemCopy( pBlock, &s_errorBlock ); - hb_itemCopy( pObject, pError ); - - hb_evalNew( &eval, pBlock ); - hb_evalPutParam( &eval, pObject ); - - pResult = hb_evalLaunch( &eval ); - hb_evalRelease( &eval ); + pResult = hb_itemDo( &s_errorBlock, 1, pError ); s_iLaunchCount--; @@ -212,10 +199,6 @@ PHB_ITEM hb_errLaunchSubst( PHB_ITEM pError ) if( pError ) { - EVALINFO eval; - PHB_ITEM pBlock; - PHB_ITEM pObject; - /* Check if we have a valid error handler */ if( hb_itemType( &s_errorBlock ) != IT_BLOCK ) @@ -226,21 +209,11 @@ PHB_ITEM hb_errLaunchSubst( PHB_ITEM pError ) if( s_iLaunchCount == HB_ERROR_LAUNCH_MAX ) hb_errInternal( 9999, "Too many recursive ERRORBLOCK() calls", NULL, NULL ); - s_iLaunchCount++; - /* Launch the error handler: "xResult := EVAL( ErrorBlock(), oError )" */ - pBlock = hb_itemNew( NULL ); - pObject = hb_itemNew( NULL ); + s_iLaunchCount++; - hb_itemCopy( pBlock, &s_errorBlock ); - hb_itemCopy( pObject, pError ); - - hb_evalNew( &eval, pBlock ); - hb_evalPutParam( &eval, pObject ); - - pResult = hb_evalLaunch( &eval ); - hb_evalRelease( &eval ); + pResult = hb_itemDo( &s_errorBlock, 1, pError ); s_iLaunchCount--; diff --git a/harbour/source/rtl/extend.c b/harbour/source/rtl/extend.c index c8169e989a..46ce693a02 100644 --- a/harbour/source/rtl/extend.c +++ b/harbour/source/rtl/extend.c @@ -479,39 +479,17 @@ void hb_retnl( long lNumber ) void hb_retndlen( double dNumber, WORD wWidth, WORD wDecimal ) { - if( wWidth == 0 || wWidth > 99 ) - wWidth = ( dNumber > 10000000000.0 ) ? 20 : 10; - - if( wDecimal == ( ( WORD ) -1 ) || ( wDecimal != 0 && wDecimal >= ( wWidth - 1 ) ) ) - wDecimal = hb_set.HB_SET_DECIMALS; - - hb_itemClear( &stack.Return ); - stack.Return.type = IT_DOUBLE; - stack.Return.item.asDouble.value = dNumber; - stack.Return.item.asDouble.length = wWidth; - stack.Return.item.asDouble.decimal = wDecimal; + hb_itemPutNDLen( &stack.Return, dNumber, wWidth, wDecimal ); } void hb_retnilen( int iNumber, WORD wWidth ) { - if( wWidth == 0 || wWidth > 99 ) - wWidth = 10; - - hb_itemClear( &stack.Return ); - stack.Return.type = IT_INTEGER; - stack.Return.item.asInteger.value = iNumber; - stack.Return.item.asInteger.length = wWidth; + hb_itemPutNILen( &stack.Return, iNumber, wWidth ); } void hb_retnllen( long lNumber, WORD wWidth ) { - if( wWidth == 0 || wWidth > 99 ) - wWidth = 10; - - hb_itemClear( &stack.Return ); - stack.Return.type = IT_LONG; - stack.Return.item.asLong.value = lNumber; - stack.Return.item.asLong.length = wWidth; + hb_itemPutNLLen( &stack.Return, lNumber, wWidth ); } void hb_storc( char * szText, int iParam, ... ) diff --git a/harbour/source/rtl/itemapi.c b/harbour/source/rtl/itemapi.c index 1e05f6c4a4..1b6a3d5bb2 100644 --- a/harbour/source/rtl/itemapi.c +++ b/harbour/source/rtl/itemapi.c @@ -25,12 +25,17 @@ /* Harbour Project source code http://www.Harbour-Project.org/ The following functions are Copyright 1999 Victor Szel : + hb_itemDo() ( based on HB_DO() by Ryszard Glab ) + hb_itemDoC() ( based on HB_DO() by Ryszard Glab ) hb_itemPutNI() hb_itemGetNI() hb_itemGetCPtr() hb_itemGetCLen() hb_itemGetNLen() hb_itemSetNLen() + hb_itemPutNDLen() + hb_itemPutNILen() + hb_itemPutNLLen() See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms. */ @@ -43,61 +48,42 @@ BOOL hb_evalNew( PEVALINFO pEvalInfo, PHB_ITEM pItem ) { - BOOL bResult = FALSE; + BOOL bResult; if( pEvalInfo ) { memset( pEvalInfo, 0, sizeof( EVALINFO ) ); pEvalInfo->pItems[ 0 ] = pItem; + pEvalInfo->paramCount = 0; bResult = TRUE; } + else + bResult = FALSE; return bResult; } +/* NOTE: CA-Cl*pper is buggy and will not check if more parameters are + added than the maximum (9) .*/ + BOOL hb_evalPutParam( PEVALINFO pEvalInfo, PHB_ITEM pItem ) { - BOOL bResult = FALSE; + BOOL bResult; - if( pEvalInfo ) + if( pEvalInfo && pItem && pEvalInfo->paramCount < HB_EVAL_PARAM_MAX_ ) { - WORD w; - - for( w = 1; w < HB_EVAL_PARAM_MAX_ + 1; w++ ) /* note that 0 position is used by the codeblock or function name item */ - { - if( pEvalInfo->pItems[ w ] == NULL ) - { - pEvalInfo->pItems[ w ] = pItem; - bResult = TRUE; - break; - } - } - } - - return bResult; -} - -BOOL hb_evalRelease( PEVALINFO pEvalInfo ) -{ - BOOL bResult = FALSE; - - if( pEvalInfo ) - { - WORD w; - - for( w = 0; w < HB_EVAL_PARAM_MAX_ + 1; w++ ) - /* NOTE: NULL pointer is checked by hb_itemRelease() */ - hb_itemRelease( pEvalInfo->pItems[ w ] ); - + pEvalInfo->pItems[ ++pEvalInfo->paramCount ] = pItem; bResult = TRUE; } + else + bResult = FALSE; return bResult; } PHB_ITEM hb_evalLaunch( PEVALINFO pEvalInfo ) { - PHB_ITEM pResult = NULL; + PHB_ITEM pResult; if( pEvalInfo ) { @@ -107,9 +93,9 @@ PHB_ITEM hb_evalLaunch( PEVALINFO pEvalInfo ) { hb_vmPushSymbol( hb_dynsymGet( hb_itemGetC( pEvalInfo->pItems[ 0 ] ) )->pSymbol ); hb_vmPushNil(); - while( w < ( HB_EVAL_PARAM_MAX_ + 1 ) && pEvalInfo->pItems[ w ] ) + while( w <= pEvalInfo->paramCount ) hb_vmPush( pEvalInfo->pItems[ w++ ] ); - hb_vmDo( w - 1 ); + hb_vmDo( pEvalInfo->paramCount ); pResult = hb_itemNew( NULL ); hb_itemCopy( pResult, &stack.Return ); @@ -118,14 +104,150 @@ PHB_ITEM hb_evalLaunch( PEVALINFO pEvalInfo ) { hb_vmPushSymbol( &symEval ); hb_vmPush( pEvalInfo->pItems[ 0 ] ); - while( w < ( HB_EVAL_PARAM_MAX_ + 1 ) && pEvalInfo->pItems[ w ] ) + while( w <= pEvalInfo->paramCount ) hb_vmPush( pEvalInfo->pItems[ w++ ] ); - hb_vmDo( w - 1 ); + hb_vmDo( pEvalInfo->paramCount ); pResult = hb_itemNew( NULL ); hb_itemCopy( pResult, &stack.Return ); } + else + pResult = NULL; } + else + pResult = NULL; + + return pResult; +} + +BOOL hb_evalRelease( PEVALINFO pEvalInfo ) +{ + BOOL bResult; + + if( pEvalInfo ) + { + WORD w; + + for( w = 0; w <= pEvalInfo->paramCount; w++ ) + { + hb_itemRelease( pEvalInfo->pItems[ w ] ); + pEvalInfo->pItems[ w ] = NULL; + } + + pEvalInfo->paramCount = 0; + bResult = TRUE; + } + else + bResult = FALSE; + + return bResult; +} + +/* NOTE: Same purpose as hb_evalLaunch(), but simpler, faster and more flexible. + It can be used to call symbols, functions names, or blocks, the items + don't need to be duplicated when passed as argument, one line is + enough to initiate a call, the number of parameters is not limited. */ + +PHB_ITEM hb_itemDo( PHB_ITEM pItem, USHORT uiPCount, ... ) +{ + PHB_ITEM pResult; + + if( pItem ) + { + if( IS_STRING( pItem ) ) + { + PHB_DYNS pDynSym = hb_dynsymGet( hb_itemGetCPtr( pItem ) ); + + if( pDynSym ) + { + USHORT uiParam; + va_list va; + + va_start( va, uiPCount ); + hb_vmPushSymbol( pDynSym->pSymbol ); + hb_vmPushNil(); + for( uiParam = 1; uiParam <= uiPCount; uiParam++ ) + hb_vmPush( va_arg( va, PHB_ITEM ) ); + hb_vmDo( uiPCount ); + va_end( va ); + + pResult = hb_itemNew( NULL ); + hb_itemCopy( pResult, &stack.Return ); + } + } + else if( IS_BLOCK( pItem ) ) + { + USHORT uiParam; + va_list va; + + va_start( va, uiPCount ); + hb_vmPushSymbol( &symEval ); + hb_vmPush( pItem ); + for( uiParam = 1; uiParam <= uiPCount; uiParam++ ) + hb_vmPush( va_arg( va, PHB_ITEM ) ); + hb_vmDo( uiPCount ); + va_end( va ); + + pResult = hb_itemNew( NULL ); + hb_itemCopy( pResult, &stack.Return ); + } + else if( IS_SYMBOL( pItem ) ) + { + USHORT uiParam; + va_list va; + + va_start( va, uiPCount ); + hb_vmPushSymbol( pItem->item.asSymbol.value ); + hb_vmPushNil(); + for( uiParam = 1; uiParam <= uiPCount; uiParam++ ) + hb_vmPush( va_arg( va, PHB_ITEM ) ); + hb_vmDo( uiPCount ); + va_end( va ); + + pResult = hb_itemNew( NULL ); + hb_itemCopy( pResult, &stack.Return ); + } + else + pResult = NULL; + } + else + pResult = NULL; + + return pResult; +} + +/* NOTE: Same as hb_itemDo(), but even simpler, since the function name can be + directly passed as a zero terminated string. */ + +PHB_ITEM hb_itemDoC( char * szFunc, USHORT uiPCount, ... ) +{ + PHB_ITEM pResult; + + if( szFunc ) + { + PHB_DYNS pDynSym = hb_dynsymGet( szFunc ); + + if( pDynSym ) + { + USHORT uiParam; + va_list va; + + va_start( va, uiPCount ); + hb_vmPushSymbol( pDynSym->pSymbol ); + hb_vmPushNil(); + for( uiParam = 1; uiParam <= uiPCount; uiParam++ ) + hb_vmPush( va_arg( va, PHB_ITEM ) ); + hb_vmDo( uiPCount ); + va_end( va ); + + pResult = hb_itemNew( NULL ); + hb_itemCopy( pResult, &stack.Return ); + } + else + pResult = NULL; + } + else + pResult = NULL; return pResult; } @@ -286,8 +408,8 @@ BOOL hb_itemFreeC( char * szText ) } /* NOTE: Clipper is buggy and will not append a trailing zero, although - the NG says that it will. Check your buffers, since what may have - worked with Clipper could overrun the buffer with Harbour. + the NG says that it will. Check your buffers, since what may have + worked with Clipper could overrun the buffer with Harbour. The correct buffer size is 9 bytes: char szDate[ 9 ] */ char * hb_itemGetDS( PHB_ITEM pItem, char * szDate ) @@ -474,6 +596,61 @@ PHB_ITEM hb_itemPutNL( PHB_ITEM pItem, long lNumber ) return pItem; } +PHB_ITEM hb_itemPutNDLen( PHB_ITEM pItem, double dNumber, WORD wWidth, WORD wDecimal ) +{ + if( pItem ) + hb_itemClear( pItem ); + else + pItem = hb_itemNew( NULL ); + + if( wWidth == 0 || wWidth > 99 ) + wWidth = ( dNumber > 10000000000.0 ) ? 20 : 10; + + if( wDecimal == ( ( WORD ) -1 ) || ( wDecimal != 0 && wDecimal >= ( wWidth - 1 ) ) ) + wDecimal = hb_set.HB_SET_DECIMALS; + + pItem->type = IT_DOUBLE; + pItem->item.asDouble.length = wWidth; + pItem->item.asDouble.decimal = wDecimal; + pItem->item.asDouble.value = dNumber; + + return pItem; +} + +PHB_ITEM hb_itemPutNILen( PHB_ITEM pItem, int iNumber, WORD wWidth ) +{ + if( pItem ) + hb_itemClear( pItem ); + else + pItem = hb_itemNew( NULL ); + + if( wWidth == 0 || wWidth > 99 ) + wWidth = 10; + + pItem->type = IT_INTEGER; + pItem->item.asInteger.length = wWidth; + pItem->item.asInteger.value = iNumber; + + return pItem; +} + +PHB_ITEM hb_itemPutNLLen( PHB_ITEM pItem, long lNumber, WORD wWidth ) +{ + if( pItem ) + hb_itemClear( pItem ); + else + pItem = hb_itemNew( NULL ); + + if( wWidth == 0 || wWidth > 99 ) + wWidth = 10; + + pItem->type = IT_LONG; + pItem->item.asLong.length = wWidth; + pItem->item.asLong.value = lNumber; + + return pItem; +} + void hb_itemGetNLen( PHB_ITEM pItem, WORD * pwWidth, WORD * pwDecimal ) { if( pItem ) diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index e93c96f6d1..c7acbedc07 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -2379,7 +2379,7 @@ void hb_vmRetValue( void ) hb_itemCopy( &stack.Return, stack.pPos ); /* copy it */ hb_itemClear( stack.pPos ); /* now clear it */ - HB_DEBUG( "RetValue\n" ); + HB_DEBUG( "hb_vmRetValue\n" ); } void hb_stackPop( void ) diff --git a/harbour/source/vm/initsymb.c b/harbour/source/vm/initsymb.c index 7f072c6e64..9cf5288ee3 100644 --- a/harbour/source/vm/initsymb.c +++ b/harbour/source/vm/initsymb.c @@ -60,6 +60,7 @@ extern HARBOUR HB_RTRIM( void ); extern HARBOUR HB_SECONDS( void ); extern HARBOUR HB_SELECT( void ); extern HARBOUR HB_SETPOS( void ); +extern HARBOUR HB_SETPOSBS( void ); extern HARBOUR HB_SPACE( void ); extern HARBOUR HB_SQRT( void ); extern HARBOUR HB_STR( void ); @@ -125,6 +126,7 @@ static HB_SYMB symbols[] = { { "SECONDS" , FS_PUBLIC, HB_SECONDS , 0 }, { "SELECT" , FS_PUBLIC, HB_SELECT , 0 }, { "SETPOS" , FS_PUBLIC, HB_SETPOS , 0 }, + { "SETPOSBS" , FS_PUBLIC, HB_SETPOSBS , 0 }, { "SPACE" , FS_PUBLIC, HB_SPACE , 0 }, { "SQRT" , FS_PUBLIC, HB_SQRT , 0 }, { "STR" , FS_PUBLIC, HB_STR , 0 }, diff --git a/harbour/tests/working/rtl_test.prg b/harbour/tests/working/rtl_test.prg index c33420eef1..b8e0a4ad56 100644 --- a/harbour/tests/working/rtl_test.prg +++ b/harbour/tests/working/rtl_test.prg @@ -448,16 +448,16 @@ FUNCTION Main( cPar1 ) TEST_LINE( lcString >= 1 , "E BASE 1076 Argument error >= F:S" ) TEST_LINE( lcString <> 1 , "E BASE 1072 Argument error <> F:S" ) TEST_LINE( lcString == 1 , "E BASE 1070 Argument error == F:S" ) - TEST_LINE( loObject == loObject , "E BASE 1070 Argument error == F:S" ) - TEST_LINE( {} == {} , "E BASE 1070 Argument error == F:S" ) + TEST_LINE( loObject == loObject , .T. ) + TEST_LINE( loObject == ErrorNew() , .F. ) + TEST_LINE( loObject == TBColumnNew() , .F. ) + TEST_LINE( laArray == laArray , .T. ) + TEST_LINE( {} == {} , .F. ) TEST_LINE( {|| NIL } == {|| NIL } , "E BASE 1070 Argument error == F:S" ) TEST_LINE( lcString = 1 , "E BASE 1071 Argument error = F:S" ) TEST_LINE( lcString < 1 , "E BASE 1073 Argument error < F:S" ) TEST_LINE( lcString <= 1 , "E BASE 1074 Argument error <= F:S" ) -/* NOTE: Harbour RDD will GPF if commented out. */ -#ifndef __HARBOUR__ - /* NOTE: TEST_CALL() should be used here, since CA-Cl*pper can't preprocess the TEST_LINE() variation properly. */ // TEST_LINE( ("NOTHERE")->NOFIELD , "E BASE 1002 Alias does not exist NOTHERE F:R" ) @@ -488,8 +488,6 @@ FUNCTION Main( cPar1 ) TEST_LINE( 200->({|| NIL }) , "{||...}" ) TEST_LINE( 200->(.T.) , .T. ) -#endif - TEST_LINE( loObject:hello , "E BASE 1004 No exported method HELLO F:S" ) TEST_LINE( loObject:hello := 1 , "E BASE 1005 No exported variable HELLO F:S" ) @@ -697,6 +695,8 @@ FUNCTION Main( cPar1 ) TEST_LINE( PadR(NIL, 5) , "" ) TEST_LINE( PadR(.T., 5) , "" ) TEST_LINE( PadR(10, 5) , "10 " ) + TEST_LINE( PadR(Year(SToD("19800101")), 5) , "1980 " ) + TEST_LINE( PadR(Day(SToD("19800101")), 5) , "1 " ) TEST_LINE( PadR("abcdef", -5) , "" ) TEST_LINE( PadR("abcdef", 0) , "" ) TEST_LINE( PadR("abcdef", 5) , "abcde" ) @@ -709,6 +709,8 @@ FUNCTION Main( cPar1 ) TEST_LINE( PadL(NIL, 5) , "" ) TEST_LINE( PadL(.T., 5) , "" ) TEST_LINE( PadL(10, 5) , " 10" ) + TEST_LINE( PadL(Year(SToD("19800101")), 5) , " 1980" ) + TEST_LINE( PadL(Day(SToD("19800101")), 5) , " 1" ) TEST_LINE( PadL("abcdef", -5) , "" ) TEST_LINE( PadL("abcdef", 0) , "" ) TEST_LINE( PadL("abcdef", 5) , "abcde" ) /* QUESTION: CA-Cl*pper "bug", should return: "bcdef" ? */ @@ -721,6 +723,8 @@ FUNCTION Main( cPar1 ) TEST_LINE( PadC(NIL, 5) , "" ) TEST_LINE( PadC(.T., 5) , "" ) TEST_LINE( PadC(10, 5) , " 10 " ) + TEST_LINE( PadC(Year(SToD("19800101")), 5) , "1980 " ) + TEST_LINE( PadC(Day(SToD("19800101")), 5) , " 1 " ) TEST_LINE( PadC("abcdef", -5) , "" ) TEST_LINE( PadC("abcdef", 0) , "" ) TEST_LINE( PadC("abcdef", 2) , "ab" ) /* QUESTION: CA-Cl*pper "bug", should return: "cd" ? */