From f311dc1f93ff0933f25e08e46d3e63724cdceebd Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Thu, 2 Sep 1999 10:49:57 +0000 Subject: [PATCH] 19990902-12:20 GMT+1 --- harbour/ChangeLog | 45 ++++++- harbour/funclist.txt | 2 +- harbour/include/filesys.h | 3 +- harbour/include/itemapi.h | 1 + harbour/source/rtl/arrays.c | 186 ++++++++++------------------- harbour/source/rtl/console.c | 39 ++---- harbour/source/rtl/dates.c | 23 ++-- harbour/source/rtl/descend.c | 4 - harbour/source/rtl/dir.c | 3 +- harbour/source/rtl/errorapi.c | 14 ++- harbour/source/rtl/extend.c | 15 +-- harbour/source/rtl/filesys.c | 14 ++- harbour/source/rtl/itemapi.c | 9 ++ harbour/source/vm/hvm.c | 102 +++++++--------- harbour/tests/working/rtl_test.prg | 128 +++++++++++++------- 15 files changed, 308 insertions(+), 280 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 6169becdd8..416c3df689 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,46 @@ +19990902-12:20 GMT+1 Victor Szel + * tests/working/rtl_test.prg + + STOD() tests added. + * source/rtl/dir.c + * Direct stack access changed to hb_itemReturn(). + * source/rtl/hvm.c + ! hb_vmEqual(), hb_vmNotEqual() didn't handle DATE type. Fixed. + % hb_vmEqual(), hb_vmNotEqual() reordered the order of type to be a bit + more efficient. + % hb_vmEqual(), hb_vmNotEqual(), hb_vmGreater*(), hb_vmLess*() function + variable scopes optimed. They need less stack space now. + * source/rtl/errorapi.c + funclist.txt + + First pass of DOSERROR() implementation. + * source/rtl/dates.c + source/rtl/extend.c + source/rtl/itemapi.c + + hb_dateStrPut() now takes care of filling the target with spaces when + the date is empty, so from now on the caller shouldn't bother with this. + This has also fixed a possible bug in RDD/PutValue with empty date. + * source/rtl/itemapi.c + include/itemapi.h + + hb_itemGetCLen() function added, which simply returns the length of + STRING item, arrays.c uses it right now. + * source/rtl/arrays.c + * Many stack.return accesses converted to use hb_itemReturn(). + * One hb_itemClear()/hb_xfree() call pair converted to hb_itemRelease(). + % Replaced internal hb_arrayLen() calls with direct access to the + array structure. + * hb_arrayGet*() functions will call the proper Item API function instead + of repeating the functionality. + * source/rtl/console.c + * hb_fsSetMode() -> hb_fsSetDevMode() + * include/filesys.h + source/filesys.c + + hb_fsSetError() added, to be able to get/set the last error number + in internal functions which uses the FS API. + * hb_fsSetMode() -> hb_fsSetDevMode() + * source/rtl/descend.c + - One obsolete comment removed. + * source/rtl/console.c + ! Some formatting errors removed. + 19990901-21:24 EDT Paul Tucker * source/rtl/filesys.c * hb_fsReadLarge() -> drop out on eof @@ -26,7 +69,7 @@ ! hb_setRelease() called close_binary() instead of close_text() for hb_set_extrahan. Fixed. - Removed a bunch of (now) unneeded include files and OS branched. - Source look kind of clean now. + Source looks kind of clean now. * config/rules.cf make_tpl.* + Added the L_USR variable, to make it possible to pass custom parameters diff --git a/harbour/funclist.txt b/harbour/funclist.txt index 3707bc0f6c..25054ab6e5 100644 --- a/harbour/funclist.txt +++ b/harbour/funclist.txt @@ -96,7 +96,7 @@ DISPBOX ;R; DISPCOUNT ;S; DISPEND ;S; DISPOUT ;R; -DOSERROR ;N; +DOSERROR ;S; DOW ;R; DTOC ;R; DTOS ;R; diff --git a/harbour/include/filesys.h b/harbour/include/filesys.h index 8c92de8426..140cc0c7af 100644 --- a/harbour/include/filesys.h +++ b/harbour/include/filesys.h @@ -70,6 +70,7 @@ extern BYTE * hb_fsCurDir ( USHORT uiDrive ); extern BYTE hb_fsCurDrv ( void ); extern int hb_fsDelete ( BYTE * pFilename ); extern USHORT hb_fsError ( void ); +extern void hb_fsSetError ( USHORT uiError ); extern FHANDLE hb_fsExtOpen ( BYTE * pFilename, BYTE * pDefExt, USHORT uiFlags, BYTE * pPaths, PHB_ITEM pError ); extern USHORT hb_fsIsDrv ( BYTE nDrive ); @@ -82,7 +83,7 @@ extern ULONG hb_fsReadLarge ( FHANDLE hFileHandle, BYTE * pBuff, ULONG ulCou extern BOOL hb_fsRmDir ( BYTE * pDirName ); extern int hb_fsRename ( BYTE * pOldName, BYTE * pNewName ); extern ULONG hb_fsSeek ( FHANDLE hFileHandle, LONG lOffset, USHORT uiMode ); -extern void hb_fsSetMode ( FHANDLE hFileHandle, USHORT uiMode ); +extern void hb_fsSetDevMode ( FHANDLE hFileHandle, USHORT uiDevMode ); extern USHORT hb_fsWrite ( FHANDLE hFileHandle, BYTE * pBuff, USHORT ulCount ); extern ULONG hb_fsWriteLarge ( FHANDLE hFileHandle, BYTE * pBuff, ULONG ulCount ); diff --git a/harbour/include/itemapi.h b/harbour/include/itemapi.h index 8bf75b937b..bbc34e2f0a 100644 --- a/harbour/include/itemapi.h +++ b/harbour/include/itemapi.h @@ -47,6 +47,7 @@ extern PHB_ITEM hb_itemArrayPut ( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem extern ULONG hb_itemCopyC ( PHB_ITEM pItem, char *szBuffer, ULONG ulLen ); extern BOOL hb_itemFreeC ( char *szText ); extern char * hb_itemGetC ( PHB_ITEM pItem ); +extern ULONG hb_itemGetCLen ( PHB_ITEM pItem ); extern char * hb_itemGetDS ( PHB_ITEM pItem, char *szDate ); extern BOOL hb_itemGetL ( PHB_ITEM pItem ); extern double hb_itemGetND ( PHB_ITEM pItem ); diff --git a/harbour/source/rtl/arrays.c b/harbour/source/rtl/arrays.c index 3c2f60fe65..5b5a23c7c9 100644 --- a/harbour/source/rtl/arrays.c +++ b/harbour/source/rtl/arrays.c @@ -66,20 +66,8 @@ char * hb_arrayGetDate( PHB_ITEM pArray, ULONG ulIndex, char * szDate ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) - { - PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; - - if( IS_DATE( pItem ) && pItem->item.asDate.value > 0 ) - { - long lDay, lMonth, lYear; - - hb_dateDecode( pItem->item.asDate.value, &lDay, &lMonth, &lYear ); - hb_dateStrPut( szDate, lDay, lMonth, lYear ); - } - else - memset( szDate, ' ', 8 ); - } + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + hb_itemGetDS( pArray->item.asArray.value->pItems + ulIndex - 1, szDate ); else hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); } @@ -93,22 +81,8 @@ BOOL hb_arrayGetBool( PHB_ITEM pArray, ULONG ulIndex ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) - { - PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; - - if( IS_LOGICAL( pItem ) ) - return pItem->item.asLogical.value; - - else if( IS_INTEGER( pItem ) ) - return pItem->item.asInteger.value != 0; - - else if( IS_LONG( pItem ) ) - return pItem->item.asLong.value != 0; - - else if( IS_DOUBLE( pItem ) ) - return pItem->item.asDouble.value != 0.0; - } + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + return hb_itemGetL( pArray->item.asArray.value->pItems + ulIndex - 1 ); else hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); } @@ -122,22 +96,8 @@ double hb_arrayGetDouble( PHB_ITEM pArray, ULONG ulIndex ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) - { - PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; - - if( IS_INTEGER( pItem ) ) - return pItem->item.asInteger.value; - - else if( IS_LONG( pItem ) ) - return pItem->item.asLong.value; - - else if( IS_DOUBLE( pItem ) ) - return pItem->item.asDouble.value; - - else if( IS_DATE( pItem ) ) - return pItem->item.asDate.value; - } + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + return hb_itemGetND( pArray->item.asArray.value->pItems + ulIndex - 1 ); else hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); } @@ -151,7 +111,7 @@ double hb_arrayGetDouble( PHB_ITEM pArray, ULONG ulIndex ) void hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ) /* creates a new array */ { PBASEARRAY pBaseArray = ( PBASEARRAY ) hb_xgrab( sizeof( BASEARRAY ) ); - ULONG ul; + ULONG ulPos; hb_itemClear( pItem ); @@ -167,8 +127,8 @@ void hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ) /* creates a new array */ pBaseArray->wClass = 0; pBaseArray->bSuperCast = FALSE; - for( ul = 0; ul < ulLen; ul++ ) - ( pBaseArray->pItems + ul )->type = IT_NIL; + for( ulPos = 0; ulPos < ulLen; ulPos++ ) + ( pBaseArray->pItems + ulPos )->type = IT_NIL; pItem->item.asArray.value = pBaseArray; } @@ -191,7 +151,7 @@ void hb_arrayGet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) hb_itemCopy( pItem, pArray->item.asArray.value->pItems + ( ulIndex - 1 ) ); else hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); @@ -204,7 +164,7 @@ char * hb_arrayGetString( PHB_ITEM pArray, ULONG ulIndex ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) { PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; @@ -224,13 +184,8 @@ ULONG hb_arrayGetStringLen( PHB_ITEM pArray, ULONG ulIndex ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) - { - PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; - - if( IS_STRING( pItem ) ) - return pItem->item.asString.length; - } + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + return hb_itemGetCLen( pArray->item.asArray.value->pItems + ulIndex - 1 ); else hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); } @@ -244,11 +199,8 @@ int hb_arrayGetType( PHB_ITEM pArray, ULONG ulIndex ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) - { - PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; - return pItem->type; - } + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + return hb_itemType( pArray->item.asArray.value->pItems + ulIndex - 1 ); else hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); } @@ -281,7 +233,7 @@ void hb_arraySet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) hb_itemCopy( pArray->item.asArray.value->pItems + ( ulIndex - 1 ), pItem ); else hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ) ); @@ -295,13 +247,13 @@ void hb_arraySize( PHB_ITEM pArray, ULONG ulLen ) if( IS_ARRAY( pArray ) ) { PBASEARRAY pBaseArray = pArray->item.asArray.value; - ULONG ul; + ULONG ulPos; if( ! pBaseArray->ulLen ) { pBaseArray->pItems = ( PHB_ITEM ) hb_xgrab( ulLen * sizeof( HB_ITEM ) ); - for( ul = 0; ul < ulLen; ul ++ ) - ( pBaseArray->pItems + ul )->type = IT_NIL; + for( ulPos = 0; ulPos < ulLen; ulPos++ ) + ( pBaseArray->pItems + ulPos )->type = IT_NIL; } else { @@ -310,14 +262,14 @@ void hb_arraySize( PHB_ITEM pArray, ULONG ulLen ) pBaseArray->pItems = ( PHB_ITEM ) hb_xrealloc( pBaseArray->pItems, sizeof( HB_ITEM ) * ulLen ); /* set value for new items */ - for( ul = pBaseArray->ulLen; ul < ulLen; ul++ ) - ( pBaseArray->pItems + ul )->type = IT_NIL; + for( ulPos = pBaseArray->ulLen; ulPos < ulLen; ulPos++ ) + ( pBaseArray->pItems + ulPos )->type = IT_NIL; } else if( pBaseArray->ulLen > ulLen ) { /* release old items */ - for( ul = ulLen; ul < pBaseArray->ulLen; ul++ ) - hb_itemClear( pBaseArray->pItems + ul ); + for( ulPos = ulLen; ulPos < pBaseArray->ulLen; ulPos++ ) + hb_itemClear( pBaseArray->pItems + ulPos ); pBaseArray->pItems = ( PHB_ITEM ) hb_xrealloc( pBaseArray->pItems, sizeof( HB_ITEM ) * ulLen ); } @@ -330,8 +282,8 @@ void hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCoun { if( IS_ARRAY( pArray ) ) { - PBASEARRAY pBaseArray; - ULONG ulLen = hb_arrayLen( pArray ); + PBASEARRAY pBaseArray = pArray->item.asArray.value; + ULONG ulLen = pBaseArray->ulLen; if( ulStart == 0 ) /* if parameter is missing */ ulStart = 1; @@ -342,9 +294,7 @@ void hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCoun if( ulStart + ulCount > ulLen ) /* check range */ ulCount = ulLen - ulStart + 1; - pBaseArray = pArray->item.asArray.value; - - for( ; ulCount > 0; ulCount --, ulStart ++ ) /* set value items */ + for( ; ulCount > 0; ulCount--, ulStart++ ) /* set value items */ hb_itemCopy( pBaseArray->pItems + ( ulStart - 1 ), pValue ); } else @@ -355,7 +305,7 @@ void hb_arrayDel( PHB_ITEM pArray, ULONG ulIndex ) { if( IS_ARRAY( pArray ) ) { - ULONG ulLen = hb_arrayLen( pArray ); + ULONG ulLen = pArray->item.asArray.value->ulLen; if( ulIndex > 0 && ulIndex <= ulLen ) { @@ -363,7 +313,7 @@ void hb_arrayDel( PHB_ITEM pArray, ULONG ulIndex ) hb_itemClear( pBaseArray->pItems + ( ulIndex - 1 ) ); - for( ulIndex --; ulIndex < ulLen; ulIndex ++ ) /* move items */ + for( ulIndex--; ulIndex < ulLen; ulIndex++ ) /* move items */ hb_itemCopy( pBaseArray->pItems + ulIndex, pBaseArray->pItems + ( ulIndex + 1 ) ); hb_itemClear( pBaseArray->pItems + ( ulLen - 1 ) ); @@ -377,7 +327,7 @@ void hb_arrayIns( PHB_ITEM pArray, ULONG ulIndex ) { if( IS_ARRAY( pArray ) ) { - ULONG ulLen = hb_arrayLen( pArray ); + ULONG ulLen = pArray->item.asArray.value->ulLen; if( ulIndex > 0 && ulIndex <= ulLen ) { @@ -385,7 +335,7 @@ void hb_arrayIns( PHB_ITEM pArray, ULONG ulIndex ) hb_itemClear( pBaseArray->pItems + ( ulLen - 1 ) ); - for( ulLen --; ulLen >= ulIndex; ulLen -- ) /* move items */ + for( ulLen--; ulLen >= ulIndex; ulLen-- ) /* move items */ hb_itemCopy( pBaseArray->pItems + ulLen, pBaseArray->pItems + ( ulLen - 1 ) ); hb_itemClear( pBaseArray->pItems + ulLen ); @@ -399,9 +349,9 @@ int hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount { if( IS_ARRAY( pArray ) && pValue->type != IT_NIL ) { + PBASEARRAY pBaseArray = pArray->item.asArray.value; + ULONG ulLen = pBaseArray->ulLen; BOOL bFound = FALSE; - PBASEARRAY pBaseArray; - ULONG ulLen = hb_arrayLen( pArray ); if( ulStart == 0 ) /* if parameter is missing */ ulStart = 1; @@ -412,9 +362,7 @@ int hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount if( ulStart + ulCount > ulLen ) /* check range */ ulCount = ulLen - ulStart + 1; - pBaseArray = pArray->item.asArray.value; - - for( ulStart --; ulCount > 0; ulCount --, ulStart ++ ) + for( ulStart--; ulCount > 0; ulCount--, ulStart++ ) { PHB_ITEM pItem = pBaseArray->pItems + ulStart; @@ -476,8 +424,8 @@ void hb_arrayEval( PHB_ITEM pArray, PHB_ITEM bBlock, ULONG ulStart, ULONG ulCoun { if( IS_ARRAY( pArray ) && IS_BLOCK( bBlock ) ) { - PBASEARRAY pBaseArray; - ULONG ulLen = hb_arrayLen( pArray ); + PBASEARRAY pBaseArray = pArray->item.asArray.value; + ULONG ulLen = pBaseArray->ulLen; if( ulStart == 0 ) /* if parameter is missing */ ulStart = 1; @@ -488,9 +436,7 @@ void hb_arrayEval( PHB_ITEM pArray, PHB_ITEM bBlock, ULONG ulStart, ULONG ulCoun if( ulStart + ulCount > ulLen ) /* check range */ ulCount = ulLen - ulStart + 1; - pBaseArray = pArray->item.asArray.value; - - for( ulStart --; ulCount > 0; ulCount --, ulStart ++ ) + for( ulStart--; ulCount > 0; ulCount--, ulStart++ ) { PHB_ITEM pItem = pBaseArray->pItems + ulStart; @@ -509,13 +455,14 @@ void hb_arrayRelease( PHB_ITEM pArray ) { if( IS_ARRAY( pArray ) ) { - ULONG ul, ulLen = hb_arrayLen( pArray ); PBASEARRAY pBaseArray = pArray->item.asArray.value; + ULONG ulLen = pBaseArray->ulLen; + ULONG ulPos; if( !pBaseArray->bSuperCast ) { - for( ul = 0; ul < ulLen; ul ++ ) - hb_itemClear( pBaseArray->pItems + ul ); + for( ulPos = 0; ulPos < ulLen; ulPos++ ) + hb_itemClear( pBaseArray->pItems + ulPos ); if( pBaseArray->pItems ) hb_xfree( pBaseArray->pItems ); @@ -534,9 +481,10 @@ void hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG ulStart, { if( IS_ARRAY( pSrcArray ) && IS_ARRAY( pDstArray ) ) { - PBASEARRAY pSrcBaseArray, pDstBaseArray; - ULONG ulSrcLen = hb_arrayLen( pSrcArray ); - ULONG ulDstLen = hb_arrayLen( pDstArray ); + PBASEARRAY pSrcBaseArray = pSrcArray->item.asArray.value; + PBASEARRAY pDstBaseArray = pDstArray->item.asArray.value; + ULONG ulSrcLen = pSrcBaseArray->ulLen; + ULONG ulDstLen = pDstBaseArray->ulLen; if( ulStart == 0 ) /* if parameter is missing */ ulStart = 1; @@ -553,10 +501,7 @@ void hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG ulStart, if( ulCount > ulDstLen ) ulCount = ulDstLen; - pSrcBaseArray = pSrcArray->item.asArray.value; - pDstBaseArray = pDstArray->item.asArray.value; - - for( ulTarget --, ulStart --; ulCount > 0; ulCount --, ulStart ++ ) + for( ulTarget--, ulStart--; ulCount > 0; ulCount--, ulStart++ ) hb_itemCopy( pDstBaseArray->pItems + ( ulTarget + ulStart ), pSrcBaseArray->pItems + ulStart ); } else @@ -569,16 +514,16 @@ PHB_ITEM hb_arrayClone( PHB_ITEM pSrcArray ) if( IS_ARRAY( pSrcArray ) ) { - PBASEARRAY pSrcBaseArray, pDstBaseArray; - ULONG ulCount, ulSrcLen = hb_arrayLen( pSrcArray ); + PBASEARRAY pSrcBaseArray = pSrcArray->item.asArray.value; + PBASEARRAY pDstBaseArray = pDstArray->item.asArray.value; + ULONG ulSrcLen = pSrcBaseArray->ulLen; + ULONG ulCount; hb_arrayNew( pDstArray, ulSrcLen ); - pSrcBaseArray = pSrcArray->item.asArray.value; - pDstBaseArray = pDstArray->item.asArray.value; pDstBaseArray->wClass = pSrcBaseArray->wClass; - for( ulCount = 0; ulCount < ulSrcLen; ulCount ++ ) + for( ulCount = 0; ulCount < ulSrcLen; ulCount++ ) { PHB_ITEM pSrcItem = pSrcBaseArray->pItems + ulCount; @@ -643,7 +588,7 @@ HARBOUR HB_AADD( void ) hb_arrayAdd( pArray, pValue ); - hb_itemCopy( &stack.Return, pValue ); + hb_itemReturn( pValue ); } else hb_errRT_BASE( EG_ARG, 1123, NULL, "AADD" ); @@ -662,7 +607,7 @@ HARBOUR HB_ASIZE( void ) hb_arraySize( pArray, MAX( lSize, 0 ) ); - hb_itemCopy( &stack.Return, pArray ); /* ASize() returns the array itself */ + hb_itemReturn( pArray ); /* ASize() returns the array itself */ } } @@ -676,27 +621,27 @@ HARBOUR HB_ATAIL( void ) HARBOUR HB_AINS( void ) { - PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); + PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); if( pArray ) { if( ISNUM( 2 ) ) hb_arrayIns( pArray, hb_parnl( 2 ) ); - hb_itemCopy( &stack.Return, pArray ); /* AIns() returns the array itself */ + hb_itemReturn( pArray ); /* AIns() returns the array itself */ } } HARBOUR HB_ADEL( void ) { - PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); + PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); if( pArray ) { if( ISNUM( 2 ) ) hb_arrayDel( pArray, hb_parnl( 2 ) ); - hb_itemCopy( &stack.Return, pArray ); /* ADel() returns the array itself */ + hb_itemReturn( pArray ); /* ADel() returns the array itself */ } } @@ -704,12 +649,12 @@ HARBOUR HB_ADEL( void ) HARBOUR HB_AFILL( void ) { - PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); + PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); if( pArray ) { hb_arrayFill( pArray, hb_param( 2, IT_ANY ), hb_parnl( 3 ), hb_parnl( 4 ) ); - hb_itemCopy( &stack.Return, pArray ); /* AFill() returns the array itself */ + hb_itemReturn( pArray ); /* AFill() returns the array itself */ } } @@ -735,7 +680,7 @@ HARBOUR HB_AEVAL( void ) if( pArray && pBlock ) { hb_arrayEval( pArray, pBlock, hb_parnl( 3 ), hb_parnl( 4 ) ); - hb_itemCopy( &stack.Return, pArray ); /* AEval() returns the array itself */ + hb_itemReturn( pArray ); /* AEval() returns the array itself */ } else hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL" ); @@ -745,26 +690,25 @@ HARBOUR HB_AEVAL( void ) HARBOUR HB_ACOPY( void ) { - PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY ); - PHB_ITEM pDstArray = hb_param( 2, IT_ARRAY ); + PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY ); + PHB_ITEM pDstArray = hb_param( 2, IT_ARRAY ); if( pSrcArray && pDstArray ) { hb_arrayCopy( pSrcArray, pDstArray, hb_parnl( 3 ), hb_parnl( 4 ), hb_parnl( 5 ) ); - hb_itemCopy( &stack.Return, pDstArray ); /* ACopy() returns the target array */ + hb_itemReturn( pDstArray ); /* ACopy() returns the target array */ } } HARBOUR HB_ACLONE( void ) { - PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY ); + PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY ); if( pSrcArray ) { PHB_ITEM pDstArray = hb_arrayClone( pSrcArray ); - hb_itemCopy( &stack.Return, pDstArray ); /* AClone() returns the new array */ - hb_itemClear( pDstArray ); - hb_xfree( pDstArray ); + hb_itemReturn( pDstArray ); /* AClone() returns the new array */ + hb_itemRelease( pDstArray ); } } diff --git a/harbour/source/rtl/console.c b/harbour/source/rtl/console.c index 8e11d24443..3eada21f3f 100644 --- a/harbour/source/rtl/console.c +++ b/harbour/source/rtl/console.c @@ -107,8 +107,8 @@ void hb_consoleInitialize( void ) /* Some compilers open stdout and stderr in text mode, but Harbour needs them to be open in binary mode. */ - hb_fsSetMode( fileno( stdout ), FM_BINARY ); - hb_fsSetMode( fileno( stderr ), FM_BINARY ); + hb_fsSetDevMode( fileno( stdout ), FM_BINARY ); + hb_fsSetDevMode( fileno( stderr ), FM_BINARY ); #ifdef HARBOUR_USE_GTAPI hb_gtInit(); @@ -327,7 +327,7 @@ static void hb_altout( char * pStr, ULONG len ) write_len = count; count = 0; } - hb_fsWrite( hb_set_althan, (BYTE *)pPtr, write_len ); + hb_fsWrite( hb_set_althan, ( BYTE * ) pPtr, write_len ); pPtr += write_len; } } @@ -349,7 +349,7 @@ static void hb_altout( char * pStr, ULONG len ) write_len = count; count = 0; } - hb_fsWrite( hb_set_extrahan, (BYTE *)pPtr, write_len ); + hb_fsWrite( hb_set_extrahan, ( BYTE * ) pPtr, write_len ); pPtr += write_len; } } @@ -371,7 +371,7 @@ static void hb_altout( char * pStr, ULONG len ) write_len = count; count = 0; } - hb_fsWrite( hb_set_printhan, (BYTE *)pPtr, write_len ); + hb_fsWrite( hb_set_printhan, ( BYTE * ) pPtr, write_len ); pPtr += write_len; } if( len + s_uiPCol > USHRT_MAX ) s_uiPCol = USHRT_MAX; @@ -400,7 +400,7 @@ static void hb_devout( char * pStr, ULONG len ) write_len = count; count = 0; } - hb_fsWrite( hb_set_printhan, (BYTE *)pPtr, write_len ); + hb_fsWrite( hb_set_printhan, ( BYTE * ) pPtr, write_len ); pPtr += write_len; } if( len + s_uiPCol > USHRT_MAX ) s_uiPCol = USHRT_MAX; @@ -473,18 +473,18 @@ void hb_devpos( WORD row, WORD col ) { if( row < s_uiPRow ) { - hb_fsWrite( hb_set_printhan, (BYTE *)"\x0C", 1 ); + hb_fsWrite( hb_set_printhan, ( BYTE * ) "\x0C", 1 ); s_uiPRow = s_uiPCol = 0; } for( count = s_uiPRow; count < row; count++ ) - hb_fsWrite( hb_set_printhan, (BYTE *)s_szCrLf, CRLF_BUFFER_LEN-1 ); + hb_fsWrite( hb_set_printhan, ( BYTE * ) s_szCrLf, CRLF_BUFFER_LEN-1 ); if( row > s_uiPRow ) s_uiPCol = 0; col += hb_set.HB_SET_MARGIN; for( count = s_uiPCol; count < col; count++ ) - hb_fsWrite( hb_set_printhan, (BYTE *)" ", 1 ); + hb_fsWrite( hb_set_printhan, ( BYTE * ) " ", 1 ); s_uiPRow = row; s_uiPCol = col; @@ -540,7 +540,7 @@ HARBOUR HB_QOUT( void ) s_uiPCol = hb_set.HB_SET_MARGIN; count = s_uiPCol; while( count-- > 0 ) - hb_fsWrite( hb_set_printhan, (BYTE *)" ", 1 ); + hb_fsWrite( hb_set_printhan, ( BYTE * ) " ", 1 ); } HB_QQOUT(); @@ -618,9 +618,7 @@ HARBOUR HB_DEVOUT( void ) /* writes a single value to the current device (screen #ifdef HARBOUR_USE_GTAPI if( ISCHAR( 2 ) ) - { hb_gtSetColorStr( pOldColor ); - } #endif } } @@ -643,9 +641,7 @@ HARBOUR HB_DISPOUT( void ) /* writes a single value to the current device (scree #ifdef HARBOUR_USE_GTAPI if( ISCHAR( 2 ) ) - { hb_gtSetColorStr( pOldColor ); - } #endif } } @@ -654,7 +650,7 @@ HARBOUR HB___EJECT( void ) /* Ejects the current page from the printer */ { if( hb_stricmp( hb_set.HB_SET_DEVICE, "PRINTER" ) == 0 && hb_set_printhan >= 0 ) { - hb_fsWrite( hb_set_printhan, (BYTE *)"\x0C\x0D", 2 ); + hb_fsWrite( hb_set_printhan, ( BYTE * ) "\x0C\x0D", 2 ); s_uiPRow = s_uiPCol = 0; } } @@ -787,22 +783,14 @@ HARBOUR HB_DISPBOX( void ) } if( ISCHAR( 5 ) ) - { hb_gtBox( hb_parni( 1 ), hb_parni( 2 ), hb_parni( 3 ), hb_parni( 4 ), hb_parc( 5 )); - } else if( ISNUM( 5 ) && hb_parni( 5 ) == 2 ) - { hb_gtBoxD( hb_parni( 1 ), hb_parni( 2 ), hb_parni( 3 ), hb_parni( 4 ) ); - } else - { hb_gtBoxS( hb_parni( 1 ), hb_parni( 2 ), hb_parni( 3 ), hb_parni( 4 ) ); - } if( ISCHAR( 6 ) ) - { hb_gtSetColorStr( szOldColor ); - } } #else if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) && ISNUM( 4 ) ) @@ -1079,10 +1067,7 @@ HARBOUR HB___ACCEPT( void ) /* Internal Clipper function used in ACCEPT command Unix compatible operating systems yet. */ szResult[ 0 ] = '\0'; /* start with something defined */ if( fgets( szResult, ACCEPT_BUFFER_LEN, stdin ) ) - { - strtok( szResult, "\n" ); /* strip off the trailing newline - if it exists */ - } + strtok( szResult, "\n" ); /* strip off the trailing newline if it exists */ #else len = 0; input = 0; diff --git a/harbour/source/rtl/dates.c b/harbour/source/rtl/dates.c index 5482c6e666..ef51ecde52 100644 --- a/harbour/source/rtl/dates.c +++ b/harbour/source/rtl/dates.c @@ -53,8 +53,6 @@ #define HB_OPTIMIZE_DTOS #endif -/* The other functions are pulled in automatically by initsymb.c */ - double hb_secondsToday( void ) { #if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__DJGPP__) /* || defined(_MSC_VER) */ @@ -151,16 +149,21 @@ void hb_dateDecode( long julian, long * plDay, long * plMonth, long * plYear ) void hb_dateStrPut( char * szDate, long lDay, long lMonth, long lYear ) { - szDate[ 0 ] = ( lYear / 1000 ) + '0'; - szDate[ 1 ] = ( ( lYear % 1000 ) / 100 ) + '0'; - szDate[ 2 ] = ( ( lYear % 100 ) / 10 ) + '0'; - szDate[ 3 ] = ( lYear % 10 ) + '0'; + if( lDay && lMonth && lYear ) + { + szDate[ 0 ] = ( lYear / 1000 ) + '0'; + szDate[ 1 ] = ( ( lYear % 1000 ) / 100 ) + '0'; + szDate[ 2 ] = ( ( lYear % 100 ) / 10 ) + '0'; + szDate[ 3 ] = ( lYear % 10 ) + '0'; - szDate[ 4 ] = ( lMonth / 10 ) + '0'; - szDate[ 5 ] = ( lMonth % 10 ) + '0'; + szDate[ 4 ] = ( lMonth / 10 ) + '0'; + szDate[ 5 ] = ( lMonth % 10 ) + '0'; - szDate[ 6 ] = ( lDay / 10 ) + '0'; - szDate[ 7 ] = ( lDay % 10 ) + '0'; + szDate[ 6 ] = ( lDay / 10 ) + '0'; + szDate[ 7 ] = ( lDay % 10 ) + '0'; + } + else + memset( szDate, ' ', 8 ); } void hb_dateStrGet( const char * szDate, long * plDay, long * plMonth, long * plYear ) diff --git a/harbour/source/rtl/descend.c b/harbour/source/rtl/descend.c index eeab3214f3..e3ea2f24da 100644 --- a/harbour/source/rtl/descend.c +++ b/harbour/source/rtl/descend.c @@ -106,10 +106,6 @@ HARBOUR HB_DESCEND( void ) pReturn = hb_itemPutND( NULL, -1 * dValue ); hb_itemReturn( pReturn ); hb_itemRelease( pReturn ); - -/* It is dangerous to operate on the stack directly - stack.Return.wDec = pItem->wDec; -*/ } else if( IS_LOGICAL( pItem ) ) hb_retl( ! pItem->item.asLogical.value ); diff --git a/harbour/source/rtl/dir.c b/harbour/source/rtl/dir.c index d61f64f17f..3618bac85d 100644 --- a/harbour/source/rtl/dir.c +++ b/harbour/source/rtl/dir.c @@ -479,8 +479,7 @@ HARBOUR HB_DIRECTORY( void ) closedir( dir ); #endif - hb_itemCopy( &stack.Return, pdir ); /* DIRECTORY() returns an array */ - + hb_itemReturn( pdir ); /* DIRECTORY() returns an array */ hb_itemRelease( pdir ); #if defined(_MSC_VER) || defined(__IBMCPP__) diff --git a/harbour/source/rtl/errorapi.c b/harbour/source/rtl/errorapi.c index 1a9495d23d..2e9de5fe8e 100644 --- a/harbour/source/rtl/errorapi.c +++ b/harbour/source/rtl/errorapi.c @@ -25,6 +25,7 @@ /* Harbour Project source code http://www.Harbour-Project.org/ The following functions are Copyright 1999 Victor Szel : + HB_DOSERROR() hb_errLaunch() hb_errLaunchSubst() hb_errGetFlags() @@ -51,8 +52,9 @@ better shows what is really the problem */ #define HB_ERROR_LAUNCH_MAX 8 -static int s_iLaunchCount = 0; static HB_ITEM s_errorBlock; +static int s_iLaunchCount = 0; +static USHORT s_uiErrorDOS = 0; /* The value of DOSERROR() */ extern HARBOUR HB_ERRORNEW( void ); @@ -78,6 +80,16 @@ HARBOUR HB_ERRORBLOCK( void ) hb_itemClear( &oldError ); } +/* TOFIX: Make it Clipper compatible */ + +HARBOUR HB_DOSERROR( void ) +{ + hb_retni( s_uiErrorDOS ); + + if( ISNUM( 1 ) ) + s_uiErrorDOS = ( USHORT ) hb_parni( 1 ); +} + void hb_errInit( void ) { hb_itemClear( &s_errorBlock ); diff --git a/harbour/source/rtl/extend.c b/harbour/source/rtl/extend.c index 257b8e54a5..51e0f11748 100644 --- a/harbour/source/rtl/extend.c +++ b/harbour/source/rtl/extend.c @@ -136,7 +136,7 @@ ULONG hb_parclen( int iParam, ... ) return 0; } -/* Same as _parclen() but return the length including the */ +/* Same as _parclen() but returns the length including the */ /* terminating zero byte */ ULONG hb_parcsiz( int iParam, ... ) @@ -189,16 +189,13 @@ char * hb_pards( int iParam, ... ) if( IS_DATE( pItem ) ) { - if( pItem->item.asDate.value > 0 ) - { - long lDay, lMonth, lYear; + long lDay, lMonth, lYear; - hb_dateDecode( pItem->item.asDate.value, &lDay, &lMonth, &lYear ); - hb_dateStrPut( stack.szDate, lDay, lMonth, lYear ); - stack.szDate[ 8 ] = '\0'; + hb_dateDecode( pItem->item.asDate.value, &lDay, &lMonth, &lYear ); + hb_dateStrPut( stack.szDate, lDay, lMonth, lYear ); + stack.szDate[ 8 ] = '\0'; - return stack.szDate; /* this guaranties good behavior when multithreading */ - } + return stack.szDate; /* this guaranties good behavior when multithreading */ } else if( IS_ARRAY( pItem ) ) { diff --git a/harbour/source/rtl/filesys.c b/harbour/source/rtl/filesys.c index b654f9b482..e3d48686c6 100644 --- a/harbour/source/rtl/filesys.c +++ b/harbour/source/rtl/filesys.c @@ -5,7 +5,8 @@ /* Harbour Project source code http://www.Harbour-Project.org/ The following functions are Copyright 1999 Victor Szel : - hb_fsSetMode() + hb_fsSetError() + hb_fsSetDevMode() hb_fsReadLarge() hb_fsWriteLarge() HB_CURDIR() @@ -349,13 +350,13 @@ void hb_fsClose( FHANDLE hFileHandle ) } -void hb_fsSetMode( FHANDLE hFileHandle, USHORT uiMode ) +void hb_fsSetDevMode( FHANDLE hFileHandle, USHORT uiDevMode ) { #if defined(__BORLANDC__) || defined(__IBMCPP__) || defined(__DJGPP__) || defined(__CYGWIN__) errno = 0; - switch( uiMode ) + switch( uiDevMode ) { case FM_BINARY: setmode( hFileHandle, O_BINARY ); @@ -370,7 +371,7 @@ void hb_fsSetMode( FHANDLE hFileHandle, USHORT uiMode ) #elif defined(_MSC_VER) errno = 0; - switch( uiMode ) + switch( uiDevMode ) { case FM_BINARY: _setmode( hFileHandle, _O_BINARY ); @@ -545,6 +546,11 @@ USHORT hb_fsError( void ) return s_uiErrorLast; } +void hb_fsSetError( USHORT uiError ) +{ + s_uiErrorLast = uiError; +} + int hb_fsDelete ( BYTE * pFilename ) { int retval; diff --git a/harbour/source/rtl/itemapi.c b/harbour/source/rtl/itemapi.c index 848cf30cdc..b6a5d2025a 100644 --- a/harbour/source/rtl/itemapi.c +++ b/harbour/source/rtl/itemapi.c @@ -25,6 +25,7 @@ /* Harbour Project source code http://www.Harbour-Project.org/ The following functions are Copyright 1999 Victor Szel : + hb_itemGetCLen() hb_itemGetNLen() hb_itemSetNLen() See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms. @@ -233,6 +234,14 @@ char * hb_itemGetC( PHB_ITEM pItem ) return NULL; } +ULONG hb_itemGetCLen( PHB_ITEM pItem ) +{ + if( pItem && IS_STRING( pItem ) ) + return pItem->item.asString.length; + else + return 0; +} + ULONG hb_itemCopyC( PHB_ITEM pItem, char * szBuffer, ULONG ulLen ) { if( pItem && IS_STRING( pItem ) ) diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 151ee711fe..8162bc5b99 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -863,19 +863,16 @@ static void hb_vmDebuggerShowLine( WORD wLine ) /* makes the debugger shows a sp void hb_vmDec( void ) { - double dNumber; - LONG lDate; - WORD wDec; - if( IS_NUMERIC( stack.pPos - 1 ) ) { - dNumber = hb_vmPopDouble( &wDec ); + WORD wDec; + double dNumber = hb_vmPopDouble( &wDec ); hb_vmPushNumber( --dNumber, wDec ); } else if( IS_DATE( stack.pPos - 1 ) ) { - lDate = hb_vmPopDate(); - hb_vmPushDate( --lDate ); /* TOFIX: Dates should decreased other way */ + LONG lDate = hb_vmPopDate(); + hb_vmPushDate( --lDate ); /* TOFIX: Dates should be decreased other way */ } else hb_errRT_BASE( EG_ARG, 1087, NULL, "--" ); @@ -1095,8 +1092,6 @@ void hb_vmEqual( BOOL bExact ) { PHB_ITEM pItem2 = stack.pPos - 1; PHB_ITEM pItem1 = stack.pPos - 2; - int i; - WORD wDec; if( IS_NIL( pItem1 ) && IS_NIL( pItem2 ) ) { @@ -1114,18 +1109,24 @@ void hb_vmEqual( BOOL bExact ) else if( IS_STRING( pItem1 ) && IS_STRING( pItem2 ) ) { - i = hb_itemStrCmp( pItem1, pItem2, bExact ); + int i = hb_itemStrCmp( pItem1, pItem2, bExact ); hb_stackPop(); hb_stackPop(); hb_vmPushLogical( i == 0 ); } + else if( IS_NUMERIC( pItem1 ) && IS_NUMERIC( pItem2 ) ) + { + WORD wDec; + hb_vmPushLogical( hb_vmPopDouble( &wDec ) == hb_vmPopDouble( &wDec ) ); + } + + else if( IS_DATE( pItem1 ) && IS_DATE( pItem2 ) ) + hb_vmPushLogical( hb_vmPopDate() == hb_vmPopDate() ); + else if( IS_LOGICAL( pItem1 ) && IS_LOGICAL( pItem2 ) ) hb_vmPushLogical( hb_vmPopLogical() == hb_vmPopLogical() ); - else if( IS_NUMERIC( pItem1 ) && IS_NUMERIC( pItem2 ) ) - hb_vmPushLogical( hb_vmPopDouble( &wDec ) == hb_vmPopDouble( &wDec ) ); - else if( IS_OBJECT( pItem1 ) && hb_objHasMsg( pItem1, "==" ) ) hb_vmOperatorCall( pItem1, pItem2, "==" ); @@ -1218,13 +1219,9 @@ void hb_vmGenArray( WORD wElements ) /* generates a wElements Array and fills it void hb_vmGreater( void ) { - double dNumber1, dNumber2; - LONG lDate1, lDate2; - int i; - if( IS_STRING( stack.pPos - 2 ) && IS_STRING( stack.pPos - 1 ) ) { - i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE ); + int i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE ); hb_stackPop(); hb_stackPop(); hb_vmPushLogical( i > 0 ); @@ -1232,15 +1229,15 @@ void hb_vmGreater( void ) else if( IS_NUMERIC( stack.pPos - 1 ) && IS_NUMERIC( stack.pPos - 2 ) ) { - dNumber2 = hb_vmPopNumber(); - dNumber1 = hb_vmPopNumber(); + double dNumber2 = hb_vmPopNumber(); + double dNumber1 = hb_vmPopNumber(); hb_vmPushLogical( dNumber1 > dNumber2 ); } else if( IS_DATE( stack.pPos - 1 ) && IS_DATE( stack.pPos - 2 ) ) { - lDate2 = hb_vmPopDate(); - lDate1 = hb_vmPopDate(); + LONG lDate2 = hb_vmPopDate(); + LONG lDate1 = hb_vmPopDate(); hb_vmPushLogical( lDate1 > lDate2 ); } @@ -1261,13 +1258,9 @@ void hb_vmGreater( void ) void hb_vmGreaterEqual( void ) { - double dNumber1, dNumber2; - LONG lDate1, lDate2; - int i; - if( IS_STRING( stack.pPos - 2 ) && IS_STRING( stack.pPos - 1 ) ) { - i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE ); + int i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE ); hb_stackPop(); hb_stackPop(); hb_vmPushLogical( i >= 0 ); @@ -1275,15 +1268,15 @@ void hb_vmGreaterEqual( void ) else if( IS_NUMERIC( stack.pPos - 1 ) && IS_NUMERIC( stack.pPos - 2 ) ) { - dNumber2 = hb_vmPopNumber(); - dNumber1 = hb_vmPopNumber(); + double dNumber2 = hb_vmPopNumber(); + double dNumber1 = hb_vmPopNumber(); hb_vmPushLogical( dNumber1 >= dNumber2 ); } else if( IS_DATE( stack.pPos - 1 ) && IS_DATE( stack.pPos - 2 ) ) { - lDate2 = hb_vmPopDate(); - lDate1 = hb_vmPopDate(); + LONG lDate2 = hb_vmPopDate(); + LONG lDate1 = hb_vmPopDate(); hb_vmPushLogical( lDate1 >= lDate2 ); } @@ -1304,18 +1297,15 @@ void hb_vmGreaterEqual( void ) void hb_vmInc( void ) { - double dNumber; - LONG lDate; - WORD wDec; - if( IS_NUMERIC( stack.pPos - 1 ) ) { - dNumber = hb_vmPopDouble( &wDec ); + WORD wDec; + double dNumber = hb_vmPopDouble( &wDec ); hb_vmPushNumber( ++dNumber, wDec ); } else if( IS_DATE( stack.pPos - 1 ) ) { - lDate = hb_vmPopDate(); + LONG lDate = hb_vmPopDate(); hb_vmPushDate( ++lDate ); } else @@ -1341,13 +1331,9 @@ void hb_vmInstring( void ) void hb_vmLess( void ) { - double dNumber1, dNumber2; - LONG lDate1, lDate2; - int i; - if( IS_STRING( stack.pPos - 2 ) && IS_STRING( stack.pPos - 1 ) ) { - i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE ); + int i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE ); hb_stackPop(); hb_stackPop(); hb_vmPushLogical( i < 0 ); @@ -1355,15 +1341,15 @@ void hb_vmLess( void ) else if( IS_NUMERIC( stack.pPos - 1 ) && IS_NUMERIC( stack.pPos - 2 ) ) { - dNumber2 = hb_vmPopNumber(); - dNumber1 = hb_vmPopNumber(); + double dNumber2 = hb_vmPopNumber(); + double dNumber1 = hb_vmPopNumber(); hb_vmPushLogical( dNumber1 < dNumber2 ); } else if( IS_DATE( stack.pPos - 1 ) && IS_DATE( stack.pPos - 2 ) ) { - lDate2 = hb_vmPopDate(); - lDate1 = hb_vmPopDate(); + LONG lDate2 = hb_vmPopDate(); + LONG lDate1 = hb_vmPopDate(); hb_vmPushLogical( lDate1 < lDate2 ); } @@ -1384,13 +1370,9 @@ void hb_vmLess( void ) void hb_vmLessEqual( void ) { - double dNumber1, dNumber2; - LONG lDate1, lDate2; - int i; - if( IS_STRING( stack.pPos - 2 ) && IS_STRING( stack.pPos - 1 ) ) { - i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE ); + int i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE ); hb_stackPop(); hb_stackPop(); hb_vmPushLogical( i <= 0 ); @@ -1398,15 +1380,15 @@ void hb_vmLessEqual( void ) else if( IS_NUMERIC( stack.pPos - 1 ) && IS_NUMERIC( stack.pPos - 2 ) ) { - dNumber2 = hb_vmPopNumber(); - dNumber1 = hb_vmPopNumber(); + double dNumber2 = hb_vmPopNumber(); + double dNumber1 = hb_vmPopNumber(); hb_vmPushLogical( dNumber1 <= dNumber2 ); } else if( IS_DATE( stack.pPos - 1 ) && IS_DATE( stack.pPos - 2 ) ) { - lDate2 = hb_vmPopDate(); - lDate1 = hb_vmPopDate(); + LONG lDate2 = hb_vmPopDate(); + LONG lDate1 = hb_vmPopDate(); hb_vmPushLogical( lDate1 <= lDate2 ); } @@ -1471,8 +1453,6 @@ void hb_vmNotEqual( void ) { PHB_ITEM pItem2 = stack.pPos - 1; PHB_ITEM pItem1 = stack.pPos - 2; - int i; - WORD wDec; if( IS_NIL( pItem1 ) && IS_NIL( pItem2 ) ) { @@ -1490,14 +1470,20 @@ void hb_vmNotEqual( void ) else if( IS_STRING( pItem1 ) && IS_STRING( pItem2 ) ) { - i = hb_itemStrCmp( pItem1, pItem2, FALSE ); + int i = hb_itemStrCmp( pItem1, pItem2, FALSE ); hb_stackPop(); hb_stackPop(); hb_vmPushLogical( i != 0 ); } else if( IS_NUMERIC( pItem1 ) && IS_NUMERIC( pItem2 ) ) + { + WORD wDec; hb_vmPushLogical( hb_vmPopDouble( &wDec ) != hb_vmPopDouble( &wDec ) ); + } + + else if( IS_DATE( pItem1 ) && IS_DATE( pItem2 ) ) + hb_vmPushLogical( hb_vmPopDate() != hb_vmPopDate() ); else if( IS_LOGICAL( pItem1 ) && IS_LOGICAL( pItem2 ) ) hb_vmPushLogical( hb_vmPopLogical() != hb_vmPopLogical() ); diff --git a/harbour/tests/working/rtl_test.prg b/harbour/tests/working/rtl_test.prg index 36d8321d71..fbc4a5c532 100644 --- a/harbour/tests/working/rtl_test.prg +++ b/harbour/tests/working/rtl_test.prg @@ -226,6 +226,45 @@ FUNCTION Main( cPar1 ) TEST_LINE( ValType( @mbBlock ) , "U" ) TEST_LINE( ValType( @maArray ) , "U" ) + /* STOD() */ + + /* For these tests in CA-Cl*pper 5.2e the following native STOD() has + been used ( not the emulated one written in Clipper ): + + CLIPPER STOD( void ) + { + // The length check is a fix to avoid buggy behaviour of _retds() + _retds( ( ISCHAR( 1 ) && _parclen( 1 ) == 8 ) ? _parc( 1 ) : " " ); + } + */ + + TEST_LINE( SToD() , SToD(" ") ) + TEST_LINE( SToD(1) , SToD(" ") ) + TEST_LINE( SToD(NIL) , SToD(" ") ) + TEST_LINE( SToD("") , SToD(" ") ) + TEST_LINE( SToD(" ") , SToD(" ") ) + TEST_LINE( SToD(" ") , SToD(" ") ) + TEST_LINE( SToD(" ") , SToD(" ") ) + TEST_LINE( SToD(" 1234567") , SToD(" ") ) + TEST_LINE( SToD("1999 ") , SToD(" ") ) + TEST_LINE( SToD("99999999") , SToD(" ") ) + TEST_LINE( SToD("99990101") , SToD(" ") ) + TEST_LINE( SToD("19991301") , SToD(" ") ) + TEST_LINE( SToD("19991241") , SToD(" ") ) + TEST_LINE( SToD("01000101") , SToD("01000101") ) + TEST_LINE( SToD("29991231") , SToD("29991231") ) + TEST_LINE( SToD("19990905") , SToD("19990905") ) + TEST_LINE( SToD(" 9990905") , SToD(" ") ) + TEST_LINE( SToD("1 990905") , SToD(" ") ) + TEST_LINE( SToD("19 90905") , SToD("17490905") ) + TEST_LINE( SToD("199 0905") , SToD("19740905") ) + TEST_LINE( SToD("1999 905") , SToD(" ") ) + TEST_LINE( SToD("19990 05") , SToD(" ") ) + TEST_LINE( SToD("199909 5") , SToD(" ") ) + TEST_LINE( SToD("1999090 ") , SToD(" ") ) + TEST_LINE( SToD("1999 9 5") , SToD(" ") ) + TEST_LINE( SToD("1999090" + Chr(0)) , SToD(" ") ) + /* DESCEND() */ TEST_LINE( Descend() , NIL ) /* Bug in CA-Cl*pper, it returns undefined trash */ @@ -258,42 +297,6 @@ FUNCTION Main( cPar1 ) TEST_LINE( Descend( SToD( "01000101" ) ) , 3474223 ) TEST_LINE( Descend( SToD( "19801220" ) ) , 2787214 ) - /* Decimals handling */ - - TEST_LINE( Str(Max(10, 12) ) , " 12" ) - TEST_LINE( Str(Max(10.50, 10) ) , " 10.50" ) - TEST_LINE( Str(Max(10, 9.50) ) , " 10" ) - TEST_LINE( Str(Max(100000, 10) ) , " 100000" ) - TEST_LINE( Str(Max(20.50, 20.670) ) , " 20.670" ) - TEST_LINE( Str(Max(20.5125, 20.670) ) , " 20.670" ) - TEST_LINE( Str(Min(10, 12) ) , " 10" ) - TEST_LINE( Str(Min(10.50, 10) ) , " 10" ) - TEST_LINE( Str(Min(10, 9.50) ) , " 9.50" ) - TEST_LINE( Str(Min(100000, 10) ) , " 10" ) - TEST_LINE( Str(Min(20.50, 20.670) ) , " 20.50" ) - TEST_LINE( Str(Min(20.5125, 20.670) ) , " 20.5125" ) - TEST_LINE( Str(Val("1") ) , "1" ) - TEST_LINE( Str(Val("15") ) , "15" ) - TEST_LINE( Str(Val("200") ) , "200" ) - TEST_LINE( Str(Val("15.0") ) , "15.0" ) - TEST_LINE( Str(Val("15.00") ) , "15.00" ) - TEST_LINE( Str(Year(SToD("19990905")) ) , " 1999" ) - TEST_LINE( Str(Month(SToD("19990905")) ) , " 9" ) - TEST_LINE( Str(Day(SToD("19990905")) ) , " 5" ) - TEST_LINE( Str(10 ) , " 10" ) - 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(100.2 * 200.12 ) , " 20052.024" ) - TEST_LINE( Str(100.20 * 200.12 ) , " 20052.0240" ) - TEST_LINE( Str(1000.2 * 200.12 ) , " 200160.024" ) - TEST_LINE( Str(100/1000 ) , " 0.10" ) - TEST_LINE( Str(100/100000 ) , " 0.00" ) - TEST_LINE( Str(10 * 10 ) , " 100" ) - TEST_LINE( Str(100 / 10 ) , " 10" ) - TEST_LINE( Str(1234567890 * 1234567890 ) , " 1524157875019052000" ) - /* (operators) */ TEST_LINE( 1 + NIL , "E BASE 1081 Argument error + F:S" ) @@ -829,6 +832,42 @@ FUNCTION Main( cPar1 ) TEST_LINE( Str(-100000, 6, -1) , "******" ) TEST_LINE( Str(-100000, 8, -1) , " -100000" ) + /* Decimals handling */ + + TEST_LINE( Str(Max(10, 12) ) , " 12" ) + TEST_LINE( Str(Max(10.50, 10) ) , " 10.50" ) + TEST_LINE( Str(Max(10, 9.50) ) , " 10" ) + TEST_LINE( Str(Max(100000, 10) ) , " 100000" ) + TEST_LINE( Str(Max(20.50, 20.670) ) , " 20.670" ) + TEST_LINE( Str(Max(20.5125, 20.670) ) , " 20.670" ) + TEST_LINE( Str(Min(10, 12) ) , " 10" ) + TEST_LINE( Str(Min(10.50, 10) ) , " 10" ) + TEST_LINE( Str(Min(10, 9.50) ) , " 9.50" ) + TEST_LINE( Str(Min(100000, 10) ) , " 10" ) + TEST_LINE( Str(Min(20.50, 20.670) ) , " 20.50" ) + TEST_LINE( Str(Min(20.5125, 20.670) ) , " 20.5125" ) + TEST_LINE( Str(Val("1") ) , "1" ) + TEST_LINE( Str(Val("15") ) , "15" ) + TEST_LINE( Str(Val("200") ) , "200" ) + TEST_LINE( Str(Val("15.0") ) , "15.0" ) + TEST_LINE( Str(Val("15.00") ) , "15.00" ) + TEST_LINE( Str(Year(SToD("19990905")) ) , " 1999" ) + TEST_LINE( Str(Month(SToD("19990905")) ) , " 9" ) + TEST_LINE( Str(Day(SToD("19990905")) ) , " 5" ) + TEST_LINE( Str(10 ) , " 10" ) + 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(100.2 * 200.12 ) , " 20052.024" ) + TEST_LINE( Str(100.20 * 200.12 ) , " 20052.0240" ) + TEST_LINE( Str(1000.2 * 200.12 ) , " 200160.024" ) + TEST_LINE( Str(100/1000 ) , " 0.10" ) + TEST_LINE( Str(100/100000 ) , " 0.00" ) + TEST_LINE( Str(10 * 10 ) , " 100" ) + TEST_LINE( Str(100 / 10 ) , " 10" ) + TEST_LINE( Str(1234567890 * 1234567890 ) , " 1524157875019052000" ) + /* STRZERO() */ TEST_LINE( StrZero(10) , "0000000010" ) @@ -1232,13 +1271,20 @@ STATIC FUNCTION ErrorMessage( oError ) #ifndef __XPP__ STATIC FUNCTION SToD( cDate ) - LOCAL cOldDateFormat := Set( _SET_DATEFORMAT, "yyyy/mm/dd" ) + LOCAL cOldDateFormat + LOCAL dDate - LOCAL dDate := CToD( SubStr( cDate, 1, 4 ) + "/" +; - SubStr( cDate, 5, 2 ) + "/" +; - SubStr( cDate, 7, 2 ) ) + IF ValType( cDate ) == "C" + cOldDateFormat := Set( _SET_DATEFORMAT, "yyyy/mm/dd" ) - Set( _SET_DATEFORMAT, cOldDateFormat ) + dDate := CToD( SubStr( cDate, 1, 4 ) + "/" +; + SubStr( cDate, 5, 2 ) + "/" +; + SubStr( cDate, 7, 2 ) ) + + Set( _SET_DATEFORMAT, cOldDateFormat ) + ELSE + dDate := CToD( "" ) + ENDIF RETURN dDate