From 7d2df1c89513e082e765968c1d65d9055ee9c276 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Fri, 3 Sep 1999 13:55:24 +0000 Subject: [PATCH] 19990903-15:30 GMT+1 --- harbour/ChangeLog | 71 ++++ harbour/funclist.txt | 1 + harbour/include/extend.h | 26 +- harbour/include/itemapi.h | 12 +- harbour/source/compiler/harbour.y | 134 ++++---- harbour/source/rtl/arrays.c | 500 ++++++++++++++++------------- harbour/source/rtl/classes.c | 2 +- harbour/source/rtl/codebloc.c | 44 +-- harbour/source/rtl/console.c | 18 ++ harbour/source/rtl/dir.c | 2 + harbour/source/rtl/extend.c | 358 ++++++--------------- harbour/source/rtl/itemapi.c | 57 +++- harbour/source/rtl/set.c | 8 +- harbour/source/vm/hvm.c | 57 ++-- harbour/tests/working/ifelse.prg | 9 +- harbour/tests/working/rtl_test.prg | 78 ++--- 16 files changed, 699 insertions(+), 678 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 953f342ab6..1e635ae53c 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,74 @@ +19990903-15:30 GMT+1 Victor Szel + * source/rtl/itemapi.c + % hb_itemPutDS() contained one more hb_itemClear() then needed. + + hb_itemGetNI(), hb_itemPutNI() added for completeness. + ! hb_itemArrayGet()/hb_itemArrayPut() checks if the passed array item ptr + is not a NULL. + * source/rtl/extend.c + * hb_parni(), hb_parnl() now uses hb_arrayGetN*() instead of + hb_arrayGetDouble(). + % Array index validation removed from hb_par*() functions, since the + called Array API is doing this. + + hb_stor*() function group now using Item API instead of duplicating + the same code. These function looks much simpler now. + ! hb_stor*() functions were suboptimal in handling the -1 parameter, they + were assigning a new value to it, then checking IS_BYREF()/IS_ARRAY(). + The logic has been optimalized. + + Optional parameter type changed to ULONG from long. + * source/rtl/array.c + include/extend.h + + Missing prototypes added to extend.h + ! hb_arrayAdd() will not throw a runtime error anymore, instead it + returns a BOOL to signal error. Error launching moved to AADD(). + ! hb_arrayClone() will not throw error. ACLONE() is more compatible now. + ! hb_arrayCopy() will not throw error, but return BOOL. + ACOPY() is more compatible now. + ! hb_arrayRelease(), hb_arrayEval() will not throw error. They will return + BOOL. + ! hb_arrayScan() will return ULONG instead of int. It will now throw an + error anymore. + ! hb_arrayGetType() will return WORD instead of int. + ! hb_arrayIns(), hb_arrayDel() will return BOOL, and not throw an error. + ! hb_arrayFill() will not throw an error, but will return BOOL, AFILL() + will check if the second parameter is not NIL. + ! hb_arrayAdd(), hb_arrayLast() checks if the passed item is an array, like + the other hb_array*() functions. + + hb_arrayNew() now returns BOOL. Actually a constant TRUE right now. + + hb_arrayLast() now return BOOL, it will return FALSE if the passed item + was not an array. + ! hb_arraySize() now return BOOL. + ! hb_arrayClone() fixed bug which caused a GPF. (Thanks Paul!) + This was introduced around yesterday. + ! hb_arrayLen() will not throw a runtime error anymore. + ! hb_arrayGet*()/hb_arraySet() will no longer throw runtime errors. + + hb_arrayGet(), hb_arraySet() now return BOOL. + + hb_arrayGetNL(), hb_arrayGetNI() added to be in sync with Item API. + ! hb_arrayGetDate() now properly clears the date field on error. + * source/rtl/dir.c + + NOTE: added about the behaviour on reaching array lenght limit. + * source/rtl/extend.c + + NOTE: added about parameter -1 + * source/rtl/set.c + * bMode name changed to bAppend + * source/rtl/console.c + funclist.txt + + SETPOSBS() undocumented Clipper function added. I don't know why is this + function so important to CA, but it's a pcode level function. + * source/compiler/harbour.y + + Added parameter count check for EVAL() + + Added parameter count check for SETPOSBS() which is and undocumented + Clipper function. Now the parameter count check list is complete. + * source/vm/hvm.c + + Added runtime parameter count check for EVAL(). + * tests/working/ifelse.prg + + Changes by Jose Lalin implemented. + * source/rtl/classes.c + source/rtl/itemapi.c (nszText -> szText) + include/rtl/itemapi.h (nszText -> szText) + ! Small formatting fix. + * source/rtl/codebloc.c + ! A few formatting errors corrected. + 19990903-14:35 GMT+2 Ryszard Glab *source/rtl/codebloc.c diff --git a/harbour/funclist.txt b/harbour/funclist.txt index 25054ab6e5..166cf09a28 100644 --- a/harbour/funclist.txt +++ b/harbour/funclist.txt @@ -216,6 +216,7 @@ SETCURSOR ;S; SETKEY ;R; SETMODE ;N; SETPOS ;R; +SETPOSBS ;R; SETPRC ;R; SOUNDEX ;S; SPACE ;R; diff --git a/harbour/include/extend.h b/harbour/include/extend.h index 677e5ce090..3ee3f2b52b 100644 --- a/harbour/include/extend.h +++ b/harbour/include/extend.h @@ -260,7 +260,7 @@ extern void hb_retnllen( long lNumber, WORD wWidth ); /* returns a long numb extern void hb_reta( ULONG ulLen ); /* returns an array with a specific length */ extern void hb_storc( char * szText, int iParam, ... ); /* stores a szString on a variable by reference */ -extern void hb_storclen( char * fixText, ULONG ulLength, int iParam, ... ); /* stores a fixed length string on a variable by reference */ +extern void hb_storclen( char * szText, ULONG ulLength, int iParam, ... ); /* stores a fixed length string on a variable by reference */ extern void hb_stords( char * szDate, int iParam, ... ); /* szDate must have yyyymmdd format */ extern void hb_storl( int iLogical, int iParam, ... ); /* stores a logical integer on a variable by reference */ extern void hb_storni( int iValue, int iParam, ... ); /* stores an integer on a variable by reference */ @@ -277,21 +277,29 @@ extern ULONG hb_xsize( void * pMem ); /* returns the size of /* array management */ extern BOOL hb_arrayError( PHB_ITEM pArray, ULONG ulIndex, BOOL bAssign ); /* Checks if the passed parameters are valid, launches runtim error if needed */ -extern void hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ); /* creates a new array */ -extern void hb_arrayGet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ); /* retrieves an item */ +extern BOOL hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ); /* creates a new array */ extern ULONG hb_arrayLen( PHB_ITEM pArray ); /* retrives the array len */ -extern void hb_arraySet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ); /* sets an array element */ -extern void hb_arraySize( PHB_ITEM pArray, ULONG ulLen ); /* sets the array total length */ -extern void hb_arrayRelease( PHB_ITEM pArray ); /* releases an array - don't call it - use ItemRelease() !!! */ -extern int hb_arrayGetType( PHB_ITEM pArray, ULONG ulIndex ); +extern BOOL hb_arrayAdd( PHB_ITEM pArray, PHB_ITEM pItemValue ); +extern BOOL hb_arrayIns( PHB_ITEM pArray, ULONG ulIndex ); +extern BOOL hb_arrayDel( PHB_ITEM pArray, ULONG ulIndex ); +extern BOOL hb_arraySize( PHB_ITEM pArray, ULONG ulLen ); /* sets the array total length */ +extern BOOL hb_arrayLast( PHB_ITEM pArray, PHB_ITEM pResult ); +extern BOOL hb_arrayRelease( PHB_ITEM pArray ); /* releases an array - don't call it - use ItemRelease() !!! */ +extern BOOL hb_arraySet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ); /* sets an array element */ +extern BOOL hb_arrayGet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ); /* retrieves an item */ extern char * hb_arrayGetString( PHB_ITEM pArray, ULONG ulIndex ); /* retrieves the string contained on an array element */ extern ULONG hb_arrayGetStringLen( PHB_ITEM pArray, ULONG ulIndex ); /* retrieves the string length contained on an array element */ extern BOOL hb_arrayGetBool( PHB_ITEM pArray, ULONG ulIndex ); /* retrieves the logical value contained on an array element */ +extern int hb_arrayGetNI( PHB_ITEM pArray, ULONG ulIndex ); /* retrieves the int value contained on an array element */ +extern long hb_arrayGetNL( PHB_ITEM pArray, ULONG ulIndex ); /* retrieves the long numeric value contained on an array element */ extern double hb_arrayGetDouble( PHB_ITEM pArray, ULONG ulIndex ); /* retrieves the double value contained on an array element */ extern char * hb_arrayGetDate( PHB_ITEM pArray, ULONG ulIndex, char * szDate ); /* retrieves the date value contained on an array element */ -extern void hb_arrayDel( PHB_ITEM pArray, ULONG ulIndex ); +extern WORD hb_arrayGetType( PHB_ITEM pArray, ULONG ulIndex ); +extern BOOL hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount ); +extern ULONG hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount ); +extern BOOL hb_arrayEval( PHB_ITEM pArray, PHB_ITEM bBlock, ULONG ulStart, ULONG ulCount ); +extern BOOL hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG ulStart, ULONG ulCount, ULONG ulTarget ); extern PHB_ITEM hb_arrayClone( PHB_ITEM pArray ); -extern void hb_arrayAdd( PHB_ITEM pArray, PHB_ITEM pItemValue ); /* string management */ diff --git a/harbour/include/itemapi.h b/harbour/include/itemapi.h index bbc34e2f0a..7b7914d167 100644 --- a/harbour/include/itemapi.h +++ b/harbour/include/itemapi.h @@ -44,23 +44,25 @@ extern BOOL hb_evalRelease ( PEVALINFO pEvalInfo ); 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 ); -extern ULONG hb_itemCopyC ( PHB_ITEM pItem, char *szBuffer, ULONG ulLen ); +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 char * hb_itemGetDS ( PHB_ITEM pItem, char * szDate ); extern BOOL hb_itemGetL ( PHB_ITEM pItem ); extern double hb_itemGetND ( PHB_ITEM pItem ); +extern int hb_itemGetNI ( PHB_ITEM pItem ); extern long hb_itemGetNL ( PHB_ITEM pItem ); extern void hb_itemGetNLen ( PHB_ITEM pItem, WORD * pwWidth, WORD * pwDecimal ); extern void hb_itemSetNLen ( PHB_ITEM pItem, WORD wWidth, WORD wDecimal ); extern PHB_ITEM hb_itemNew ( PHB_ITEM pNull ); extern PHB_ITEM hb_itemParam ( WORD wParam ); -extern PHB_ITEM hb_itemPutC ( PHB_ITEM pItem, char *szText ); -extern PHB_ITEM hb_itemPutCL ( PHB_ITEM pItem, char *nszText, ULONG ulLen ); -extern PHB_ITEM hb_itemPutDS ( PHB_ITEM pItem, char *szDate ); +extern PHB_ITEM hb_itemPutC ( PHB_ITEM pItem, char * szText ); +extern PHB_ITEM hb_itemPutCL ( PHB_ITEM pItem, char * szText, ULONG ulLen ); +extern PHB_ITEM hb_itemPutDS ( PHB_ITEM pItem, char * szDate ); 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 BOOL hb_itemRelease ( PHB_ITEM pItem ); extern PHB_ITEM hb_itemReturn ( PHB_ITEM pItem ); diff --git a/harbour/source/compiler/harbour.y b/harbour/source/compiler/harbour.y index fd630379a5..d0670d69ee 100644 --- a/harbour/source/compiler/harbour.y +++ b/harbour/source/compiler/harbour.y @@ -5905,71 +5905,73 @@ typedef struct } FUNCINFO, * PFUNCINFO; static FUNCINFO _StdFun[] = { -{ "AADD" , 2, 2 }, -{ "ABS" , 1, 1 }, -{ "ASC" , 1, 1 }, -{ "AT" , 2, 2 }, -{ "BOF" , 0, 0 }, -{ "BREAK" , 0, 1 }, -{ "CDOW" , 1, 1 }, -{ "CHR" , 1, 1 }, -{ "CMONTH" , 1, 1 }, -{ "COL" , 0, 0 }, -{ "CTOD" , 1, 1 }, -{ "DATE" , 0, 0 }, -{ "DAY" , 1, 1 }, -{ "DELETED" , 0, 0 }, -{ "DEVPOS" , 2, 2 }, -{ "DOW" , 1, 1 }, -{ "DTOC" , 1, 1 }, -{ "DTOS" , 1, 1 }, -{ "EMPTY" , 1, 1 }, -{ "EOF" , 0, 0 }, -{ "EXP" , 1, 1 }, -{ "FCOUNT" , 0, 0 }, -{ "FIELDNAME" , 1, 1 }, -{ "FILE" , 1, 1 }, -{ "FLOCK" , 0, 0 }, -{ "FOUND" , 0, 0 }, -{ "INKEY" , 0, 2 }, -{ "INT" , 1, 1 }, -{ "LASTREC" , 0, 0 }, -{ "LEFT" , 2, 2 }, -{ "LEN" , 1, 1 }, -{ "LOCK" , 0, 0 }, -{ "LOG" , 1, 1 }, -{ "LOWER" , 1, 1 }, -{ "LTRIM" , 1, 1 }, -{ "MAX" , 2, 2 }, -{ "MIN" , 2, 2 }, -{ "MONTH" , 1, 1 }, -{ "PCOL" , 0, 0 }, -{ "PCOUNT" , 0, 0 }, -{ "PROW" , 0, 0 }, -{ "RECCOUNT" , 0, 0 }, -{ "RECNO" , 0, 0 }, -{ "REPLICATE" , 2, 2 }, -{ "RLOCK" , 0, 0 }, -{ "ROUND" , 2, 2 }, -{ "ROW" , 0, 0 }, -{ "RTRIM" , 1, 2 }, /* Second parameter is a Harbour extension */ -{ "SECONDS" , 0, 0 }, -{ "SELECT" , 0, 1 }, -{ "SETPOS" , 2, 2 }, -{ "SPACE" , 1, 1 }, -{ "SQRT" , 1, 1 }, -{ "STR" , 1, 3 }, -{ "SUBSTR" , 2, 3 }, -{ "TIME" , 0, 0 }, -{ "TRANSFORM" , 2, 2 }, -{ "TRIM" , 1, 2 }, /* Second parameter is a Harbour extension */ -{ "TYPE" , 1, 1 }, -{ "UPPER" , 1, 1 }, -{ "VAL" , 1, 1 }, -{ "VALTYPE" , 1, 1 }, -{ "WORD" , 1, 1 }, -{ "YEAR" , 1, 1 }, -{ 0 , 0, 0 } +{ "AADD" , 2, 2 }, +{ "ABS" , 1, 1 }, +{ "ASC" , 1, 1 }, +{ "AT" , 2, 2 }, +{ "BOF" , 0, 0 }, +{ "BREAK" , 0, 1 }, +{ "CDOW" , 1, 1 }, +{ "CHR" , 1, 1 }, +{ "CMONTH" , 1, 1 }, +{ "COL" , 0, 0 }, +{ "CTOD" , 1, 1 }, +{ "DATE" , 0, 0 }, +{ "DAY" , 1, 1 }, +{ "DELETED" , 0, 0 }, +{ "DEVPOS" , 2, 2 }, +{ "DOW" , 1, 1 }, +{ "DTOC" , 1, 1 }, +{ "DTOS" , 1, 1 }, +{ "EMPTY" , 1, 1 }, +{ "EOF" , 0, 0 }, +{ "EVAL" , 1, -1 }, +{ "EXP" , 1, 1 }, +{ "FCOUNT" , 0, 0 }, +{ "FIELDNAME" , 1, 1 }, +{ "FILE" , 1, 1 }, +{ "FLOCK" , 0, 0 }, +{ "FOUND" , 0, 0 }, +{ "INKEY" , 0, 2 }, +{ "INT" , 1, 1 }, +{ "LASTREC" , 0, 0 }, +{ "LEFT" , 2, 2 }, +{ "LEN" , 1, 1 }, +{ "LOCK" , 0, 0 }, +{ "LOG" , 1, 1 }, +{ "LOWER" , 1, 1 }, +{ "LTRIM" , 1, 1 }, +{ "MAX" , 2, 2 }, +{ "MIN" , 2, 2 }, +{ "MONTH" , 1, 1 }, +{ "PCOL" , 0, 0 }, +{ "PCOUNT" , 0, 0 }, +{ "PROW" , 0, 0 }, +{ "RECCOUNT" , 0, 0 }, +{ "RECNO" , 0, 0 }, +{ "REPLICATE" , 2, 2 }, +{ "RLOCK" , 0, 0 }, +{ "ROUND" , 2, 2 }, +{ "ROW" , 0, 0 }, +{ "RTRIM" , 1, 2 }, /* Second parameter is a Harbour extension */ +{ "SECONDS" , 0, 0 }, +{ "SELECT" , 0, 1 }, +{ "SETPOS" , 2, 2 }, +{ "SETPOSBS" , 0, 0 }, +{ "SPACE" , 1, 1 }, +{ "SQRT" , 1, 1 }, +{ "STR" , 1, 3 }, +{ "SUBSTR" , 2, 3 }, +{ "TIME" , 0, 0 }, +{ "TRANSFORM" , 2, 2 }, +{ "TRIM" , 1, 2 }, /* Second parameter is a Harbour extension */ +{ "TYPE" , 1, 1 }, +{ "UPPER" , 1, 1 }, +{ "VAL" , 1, 1 }, +{ "VALTYPE" , 1, 1 }, +{ "WORD" , 1, 1 }, +{ "YEAR" , 1, 1 }, +{ 0 , 0, 0 } }; void CheckArgs( char * szFuncCall, int iArgs ) @@ -5995,7 +5997,7 @@ void CheckArgs( char * szFuncCall, int iArgs ) if( iPos >= 0 && ( f[ iPos ].iMinParam != -1 ) ) { - if( iArgs < f[ iPos ].iMinParam || iArgs > f[ iPos ].iMaxParam ) + if( iArgs < f[ iPos ].iMinParam || ( f[ iPos ].iMaxParam != -1 && iArgs > f[ iPos ].iMaxParam ) ) { char szMsg[ 30 ]; diff --git a/harbour/source/rtl/arrays.c b/harbour/source/rtl/arrays.c index 5b5a23c7c9..dbba99683e 100644 --- a/harbour/source/rtl/arrays.c +++ b/harbour/source/rtl/arrays.c @@ -33,82 +33,7 @@ * Internal */ -BOOL hb_arrayError( PHB_ITEM pArray, ULONG ulIndex, BOOL bAssign ) -{ - BOOL bRetVal; - - if( IS_ARRAY( pArray ) ) - { - if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) - bRetVal = FALSE; - else - { - bRetVal = TRUE; - if( bAssign ) - hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ) ); - else - hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); - } - } - else - { - bRetVal = TRUE; - if( bAssign ) - hb_errRT_BASE( EG_ARG, 1069, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ) ); - else - hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); - } - - return bRetVal; -} - -char * hb_arrayGetDate( PHB_ITEM pArray, ULONG ulIndex, char * szDate ) -{ - if( IS_ARRAY( pArray ) ) - { - 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 ) ); - } - else - hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); - - return szDate; -} - -BOOL hb_arrayGetBool( PHB_ITEM pArray, ULONG ulIndex ) -{ - if( IS_ARRAY( pArray ) ) - { - 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 ) ); - } - else - hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); - - return FALSE; -} - -double hb_arrayGetDouble( PHB_ITEM pArray, ULONG ulIndex ) -{ - if( IS_ARRAY( pArray ) ) - { - 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 ) ); - } - else - hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); - - return 0; -} - - -void hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ) /* creates a new array */ +BOOL hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ) /* creates a new array */ { PBASEARRAY pBaseArray = ( PBASEARRAY ) hb_xgrab( sizeof( BASEARRAY ) ); ULONG ulPos; @@ -120,7 +45,7 @@ void hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ) /* creates a new array */ if( ulLen > 0 ) pBaseArray->pItems = ( PHB_ITEM ) hb_xgrab( sizeof( HB_ITEM ) * ulLen ); else - pBaseArray->pItems = 0; + pBaseArray->pItems = NULL; pBaseArray->ulLen = ulLen; pBaseArray->wHolders = 1; @@ -131,118 +56,38 @@ void hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ) /* creates a new array */ ( pBaseArray->pItems + ulPos )->type = IT_NIL; pItem->item.asArray.value = pBaseArray; + + return TRUE; } -void hb_arrayAdd( PHB_ITEM pArray, PHB_ITEM pValue ) -{ - PBASEARRAY pBaseArray = ( PBASEARRAY ) pArray->item.asArray.value; - - if( pBaseArray->ulLen < ULONG_MAX ) - { - hb_arraySize( pArray, pBaseArray->ulLen + 1 ); - pBaseArray = ( PBASEARRAY ) pArray->item.asArray.value; - hb_itemCopy( pBaseArray->pItems + ( pBaseArray->ulLen - 1 ), pValue ); - } - else - hb_errRT_BASE( EG_BOUND, 1187, NULL, "AADD" ); -} - -void hb_arrayGet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ) +BOOL hb_arrayAdd( PHB_ITEM pArray, PHB_ITEM pValue ) { if( IS_ARRAY( 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 ) ); - } - else - hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); -} + PBASEARRAY pBaseArray = ( PBASEARRAY ) pArray->item.asArray.value; -char * hb_arrayGetString( PHB_ITEM pArray, ULONG ulIndex ) -{ - if( IS_ARRAY( pArray ) ) - { - if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + if( pBaseArray->ulLen < ULONG_MAX ) { - PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; + hb_arraySize( pArray, pBaseArray->ulLen + 1 ); + pBaseArray = ( PBASEARRAY ) pArray->item.asArray.value; + hb_itemCopy( pBaseArray->pItems + ( pBaseArray->ulLen - 1 ), pValue ); - if( IS_STRING( pItem ) ) - return pItem->item.asString.value; + return TRUE; } - else - hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); } - else - hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); - return ""; -} - -ULONG hb_arrayGetStringLen( PHB_ITEM pArray, ULONG ulIndex ) -{ - if( IS_ARRAY( pArray ) ) - { - 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 ) ); - } - else - hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); - - return 0; -} - -int hb_arrayGetType( PHB_ITEM pArray, ULONG ulIndex ) -{ - if( IS_ARRAY( pArray ) ) - { - 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 ) ); - } - else - hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); - - return 0; -} - -void hb_arrayLast( PHB_ITEM pArray, PHB_ITEM pResult ) -{ - if( pArray->item.asArray.value->ulLen ) - hb_itemCopy( pResult, pArray->item.asArray.value->pItems + - ( pArray->item.asArray.value->ulLen - 1 ) ); - else - hb_itemClear( pResult ); + return FALSE; } ULONG hb_arrayLen( PHB_ITEM pArray ) { if( IS_ARRAY( pArray ) ) return pArray->item.asArray.value->ulLen; - else - hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); return 0; } -void hb_arraySet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ) -{ - if( IS_ARRAY( 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 ) ); - } - else - hb_errRT_BASE( EG_ARG, 1069, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ) ); -} - -void hb_arraySize( PHB_ITEM pArray, ULONG ulLen ) +BOOL hb_arraySize( PHB_ITEM pArray, ULONG ulLen ) { if( IS_ARRAY( pArray ) ) { @@ -275,10 +120,234 @@ void hb_arraySize( PHB_ITEM pArray, ULONG ulLen ) } } pBaseArray->ulLen = ulLen; + + return TRUE; } + else + return FALSE; } -void hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount ) +BOOL hb_arrayDel( PHB_ITEM pArray, ULONG ulIndex ) +{ + if( IS_ARRAY( pArray ) ) + { + ULONG ulLen = pArray->item.asArray.value->ulLen; + + if( ulIndex > 0 && ulIndex <= ulLen ) + { + PBASEARRAY pBaseArray = pArray->item.asArray.value; + + hb_itemClear( pBaseArray->pItems + ( ulIndex - 1 ) ); + + for( ulIndex--; ulIndex < ulLen; ulIndex++ ) /* move items */ + hb_itemCopy( pBaseArray->pItems + ulIndex, pBaseArray->pItems + ( ulIndex + 1 ) ); + + hb_itemClear( pBaseArray->pItems + ( ulLen - 1 ) ); + } + + return TRUE; + } + else + return FALSE; +} + +BOOL hb_arrayIns( PHB_ITEM pArray, ULONG ulIndex ) +{ + if( IS_ARRAY( pArray ) ) + { + ULONG ulLen = pArray->item.asArray.value->ulLen; + + if( ulIndex > 0 && ulIndex <= ulLen ) + { + PBASEARRAY pBaseArray = pArray->item.asArray.value; + + hb_itemClear( pBaseArray->pItems + ( ulLen - 1 ) ); + + for( ulLen--; ulLen >= ulIndex; ulLen-- ) /* move items */ + hb_itemCopy( pBaseArray->pItems + ulLen, pBaseArray->pItems + ( ulLen - 1 ) ); + + hb_itemClear( pBaseArray->pItems + ulLen ); + } + + return TRUE; + } + else + return FALSE; +} + +BOOL hb_arrayError( PHB_ITEM pArray, ULONG ulIndex, BOOL bAssign ) +{ + BOOL bError; + + if( IS_ARRAY( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + bError = FALSE; + else + { + bError = TRUE; + if( bAssign ) + hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ) ); + else + hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); + } + } + else + { + bError = TRUE; + if( bAssign ) + hb_errRT_BASE( EG_ARG, 1069, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ) ); + else + hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); + } + + return bError; +} + +BOOL hb_arraySet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ) +{ + if( IS_ARRAY( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + { + hb_itemCopy( pArray->item.asArray.value->pItems + ( ulIndex - 1 ), pItem ); + return TRUE; + } + } + + return FALSE; +} + +BOOL hb_arrayGet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ) +{ + if( IS_ARRAY( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + { + hb_itemCopy( pItem, pArray->item.asArray.value->pItems + ( ulIndex - 1 ) ); + return TRUE; + } + } + + hb_itemClear( pItem ); + + return FALSE; +} + +char * hb_arrayGetDate( PHB_ITEM pArray, ULONG ulIndex, char * szDate ) +{ + if( IS_ARRAY( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + hb_itemGetDS( pArray->item.asArray.value->pItems + ulIndex - 1, szDate ); + } + else + memset( szDate, ' ', 8 ); + + return szDate; +} + +BOOL hb_arrayGetBool( PHB_ITEM pArray, ULONG ulIndex ) +{ + if( IS_ARRAY( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + return hb_itemGetL( pArray->item.asArray.value->pItems + ulIndex - 1 ); + } + + return FALSE; +} + +int hb_arrayGetNI( PHB_ITEM pArray, ULONG ulIndex ) +{ + if( IS_ARRAY( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + return hb_itemGetNI( pArray->item.asArray.value->pItems + ulIndex - 1 ); + } + + return 0; +} + +long hb_arrayGetNL( PHB_ITEM pArray, ULONG ulIndex ) +{ + if( IS_ARRAY( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + return hb_itemGetNL( pArray->item.asArray.value->pItems + ulIndex - 1 ); + } + + return 0; +} + +double hb_arrayGetDouble( PHB_ITEM pArray, ULONG ulIndex ) +{ + if( IS_ARRAY( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + return hb_itemGetND( pArray->item.asArray.value->pItems + ulIndex - 1 ); + } + + return 0; +} + +char * hb_arrayGetString( PHB_ITEM pArray, ULONG ulIndex ) +{ + if( IS_ARRAY( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + { + PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; + + if( IS_STRING( pItem ) ) + return pItem->item.asString.value; + } + } + + return ""; +} + +ULONG hb_arrayGetStringLen( PHB_ITEM pArray, ULONG ulIndex ) +{ + if( IS_ARRAY( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + return hb_itemGetCLen( pArray->item.asArray.value->pItems + ulIndex - 1 ); + } + + return 0; +} + +WORD hb_arrayGetType( PHB_ITEM pArray, ULONG ulIndex ) +{ + if( IS_ARRAY( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + return hb_itemType( pArray->item.asArray.value->pItems + ulIndex - 1 ); + } + + return 0; +} + +BOOL hb_arrayLast( PHB_ITEM pArray, PHB_ITEM pResult ) +{ + if( IS_ARRAY( pArray ) ) + { + if( pArray->item.asArray.value->ulLen > 0 ) + hb_itemCopy( pResult, pArray->item.asArray.value->pItems + + ( pArray->item.asArray.value->ulLen - 1 ) ); + else + hb_itemClear( pResult ); + + return TRUE; + } + + hb_itemClear( pResult ); + + return FALSE; +} + +BOOL hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount ) { if( IS_ARRAY( pArray ) ) { @@ -296,58 +365,16 @@ void hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCoun for( ; ulCount > 0; ulCount--, ulStart++ ) /* set value items */ hb_itemCopy( pBaseArray->pItems + ( ulStart - 1 ), pValue ); + + return TRUE; } else - hb_errRT_BASE( EG_ARG, 9999, NULL, hb_langDGetErrorDesc( EG_NOTARRAY ) ); + return FALSE; } -void hb_arrayDel( PHB_ITEM pArray, ULONG ulIndex ) +ULONG hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount ) { - if( IS_ARRAY( pArray ) ) - { - ULONG ulLen = pArray->item.asArray.value->ulLen; - - if( ulIndex > 0 && ulIndex <= ulLen ) - { - PBASEARRAY pBaseArray = pArray->item.asArray.value; - - hb_itemClear( pBaseArray->pItems + ( ulIndex - 1 ) ); - - for( ulIndex--; ulIndex < ulLen; ulIndex++ ) /* move items */ - hb_itemCopy( pBaseArray->pItems + ulIndex, pBaseArray->pItems + ( ulIndex + 1 ) ); - - hb_itemClear( pBaseArray->pItems + ( ulLen - 1 ) ); - } - } - else - hb_errRT_BASE( EG_ARG, 9999, NULL, hb_langDGetErrorDesc( EG_NOTARRAY ) ); -} - -void hb_arrayIns( PHB_ITEM pArray, ULONG ulIndex ) -{ - if( IS_ARRAY( pArray ) ) - { - ULONG ulLen = pArray->item.asArray.value->ulLen; - - if( ulIndex > 0 && ulIndex <= ulLen ) - { - PBASEARRAY pBaseArray = pArray->item.asArray.value; - - hb_itemClear( pBaseArray->pItems + ( ulLen - 1 ) ); - - for( ulLen--; ulLen >= ulIndex; ulLen-- ) /* move items */ - hb_itemCopy( pBaseArray->pItems + ulLen, pBaseArray->pItems + ( ulLen - 1 ) ); - - hb_itemClear( pBaseArray->pItems + ulLen ); - } - } - else - hb_errRT_BASE( EG_ARG, 9999, NULL, hb_langDGetErrorDesc( EG_NOTARRAY ) ); -} - -int hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount ) -{ - if( IS_ARRAY( pArray ) && pValue->type != IT_NIL ) + if( IS_ARRAY( pArray ) && IS_NIL( pValue ) ) { PBASEARRAY pBaseArray = pArray->item.asArray.value; ULONG ulLen = pBaseArray->ulLen; @@ -414,13 +441,11 @@ int hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount return ulStart + 1; /* arrays start from 1 */ } } - else - hb_errRT_BASE( EG_ARG, 9999, NULL, hb_langDGetErrorDesc( EG_NOTARRAY ) ); return 0; } -void hb_arrayEval( PHB_ITEM pArray, PHB_ITEM bBlock, ULONG ulStart, ULONG ulCount ) +BOOL hb_arrayEval( PHB_ITEM pArray, PHB_ITEM bBlock, ULONG ulStart, ULONG ulCount ) { if( IS_ARRAY( pArray ) && IS_BLOCK( bBlock ) ) { @@ -446,12 +471,14 @@ void hb_arrayEval( PHB_ITEM pArray, PHB_ITEM bBlock, ULONG ulStart, ULONG ulCoun hb_vmPushNumber( ( double ) ( ulStart + 1 ), 0 ); hb_vmDo( 2 ); } + + return TRUE; } else - hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL" ); + return FALSE; } -void hb_arrayRelease( PHB_ITEM pArray ) +BOOL hb_arrayRelease( PHB_ITEM pArray ) { if( IS_ARRAY( pArray ) ) { @@ -471,12 +498,14 @@ void hb_arrayRelease( PHB_ITEM pArray ) pArray->type = IT_NIL; pArray->item.asArray.value = NULL; + + return TRUE; } else - hb_errRT_BASE( EG_ARG, 9999, NULL, hb_langDGetErrorDesc( EG_NOTARRAY ) ); + return FALSE; } -void hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG ulStart, +BOOL hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG ulStart, ULONG ulCount, ULONG ulTarget ) { if( IS_ARRAY( pSrcArray ) && IS_ARRAY( pDstArray ) ) @@ -503,9 +532,11 @@ void hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG ulStart, for( ulTarget--, ulStart--; ulCount > 0; ulCount--, ulStart++ ) hb_itemCopy( pDstBaseArray->pItems + ( ulTarget + ulStart ), pSrcBaseArray->pItems + ulStart ); + + return TRUE; } else - hb_errRT_BASE( EG_ARG, 9999, NULL, hb_langDGetErrorDesc( EG_NOTARRAY ) ); + return FALSE; } PHB_ITEM hb_arrayClone( PHB_ITEM pSrcArray ) @@ -515,12 +546,13 @@ PHB_ITEM hb_arrayClone( PHB_ITEM pSrcArray ) if( IS_ARRAY( pSrcArray ) ) { PBASEARRAY pSrcBaseArray = pSrcArray->item.asArray.value; - PBASEARRAY pDstBaseArray = pDstArray->item.asArray.value; + PBASEARRAY pDstBaseArray; ULONG ulSrcLen = pSrcBaseArray->ulLen; ULONG ulCount; hb_arrayNew( pDstArray, ulSrcLen ); + pDstBaseArray = pDstArray->item.asArray.value; pDstBaseArray->wClass = pSrcBaseArray->wClass; for( ulCount = 0; ulCount < ulSrcLen; ulCount++ ) @@ -538,8 +570,6 @@ PHB_ITEM hb_arrayClone( PHB_ITEM pSrcArray ) hb_itemArrayPut( pDstArray, ulCount + 1, pSrcItem ); } } - else - hb_errRT_BASE( EG_ARG, 9999, NULL, hb_langDGetErrorDesc( EG_NOTARRAY ) ); return pDstArray; } @@ -548,6 +578,8 @@ PHB_ITEM hb_arrayClone( PHB_ITEM pSrcArray ) * HARBOUR */ +/* TOFIX: Clipper will not work with OBJECT type in these functions. */ + /* TODO: Support multiple dimensions */ HARBOUR HB_ARRAY( void ) @@ -586,9 +618,10 @@ HARBOUR HB_AADD( void ) { PHB_ITEM pValue = hb_param( 2, IT_ANY ); - hb_arrayAdd( pArray, pValue ); - - hb_itemReturn( pValue ); + if( hb_arrayAdd( pArray, pValue ) ) + hb_itemReturn( pValue ); + else + hb_errRT_BASE( EG_BOUND, 1187, NULL, "AADD" ); } else hb_errRT_BASE( EG_ARG, 1123, NULL, "AADD" ); @@ -663,9 +696,10 @@ HARBOUR HB_AFILL( void ) HARBOUR HB_ASCAN( void ) { PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); + PHB_ITEM pValue = hb_param( 2, IT_ANY ); - if( pArray ) - hb_retnl( hb_arrayScan( pArray, hb_param( 2, IT_ANY ), hb_parnl( 3 ), hb_parnl( 4 ) ) ); + if( pArray && pValue ) + hb_retnl( hb_arrayScan( pArray, pValue, hb_parnl( 3 ), hb_parnl( 4 ) ) ); else hb_retnl( 0 ); } @@ -700,6 +734,8 @@ HARBOUR HB_ACOPY( void ) } } +/* NOTE: Clipper will return NIL if the parameter is not an array */ + HARBOUR HB_ACLONE( void ) { PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY ); diff --git a/harbour/source/rtl/classes.c b/harbour/source/rtl/classes.c index 659b2ce636..fc42d5b58b 100644 --- a/harbour/source/rtl/classes.c +++ b/harbour/source/rtl/classes.c @@ -631,7 +631,7 @@ static HARBOUR hb___msgGetData( void ) PHB_ITEM pObject = stack.pBase + 1; WORD wIndex = s_pMethod->wData; - if( wIndex > ( WORD ) hb_arrayLen ( pObject ) ) + if( wIndex > ( WORD ) hb_arrayLen( pObject ) ) /* Resize needed */ hb_arraySize( pObject, wIndex ); /* Make large enough */ diff --git a/harbour/source/rtl/codebloc.c b/harbour/source/rtl/codebloc.c index c18cf96c8e..350e94cbca 100644 --- a/harbour/source/rtl/codebloc.c +++ b/harbour/source/rtl/codebloc.c @@ -60,11 +60,11 @@ HB_CODEBLOCK_PTR hb_codeblockNew( BYTE * pBuffer, { HB_CODEBLOCK_PTR pCBlock; - pCBlock =( HB_CODEBLOCK_PTR ) hb_xgrab( sizeof(HB_CODEBLOCK) ); + pCBlock = ( HB_CODEBLOCK_PTR ) hb_xgrab( sizeof( HB_CODEBLOCK ) ); /* Store the number of referenced local variables */ - pCBlock->wLocals =wLocals; + pCBlock->wLocals = wLocals; if( wLocals ) { /* NOTE: if a codeblock will be created by macro compiler then @@ -79,9 +79,9 @@ HB_CODEBLOCK_PTR hb_codeblockNew( BYTE * pBuffer, * accessed in a codeblock * The element 0 is used as the counter of references to this table */ - pCBlock->pLocals =(PHB_ITEM) hb_xgrab( (wLocals +1) * sizeof(HB_ITEM) ); - pCBlock->pLocals[ 0 ].type =IT_LONG; - pCBlock->pLocals[ 0 ].item.asLong.value =1; + pCBlock->pLocals = ( PHB_ITEM ) hb_xgrab( ( wLocals + 1 ) * sizeof( HB_ITEM ) ); + pCBlock->pLocals[ 0 ].type = IT_LONG; + pCBlock->pLocals[ 0 ].item.asLong.value = 1; while( wLocals-- ) { @@ -100,15 +100,15 @@ HB_CODEBLOCK_PTR hb_codeblockNew( BYTE * pBuffer, * pool so it can be shared by codeblocks */ - hMemvar =hb_memvarValueNew( pLocal, FALSE ); + hMemvar = hb_memvarValueNew( pLocal, FALSE ); - pLocal->type =IT_BYREF | IT_MEMVAR; - pLocal->item.asMemvar.itemsbase =hb_memvarValueBaseAddress(); - pLocal->item.asMemvar.offset =0; - pLocal->item.asMemvar.value =hMemvar; + pLocal->type = IT_BYREF | IT_MEMVAR; + pLocal->item.asMemvar.itemsbase = hb_memvarValueBaseAddress(); + pLocal->item.asMemvar.offset = 0; + pLocal->item.asMemvar.value = hMemvar; hb_memvarValueIncRef( pLocal->item.asMemvar.value ); - memcpy( pCBlock->pLocals + w, pLocal, sizeof(HB_ITEM) ); + memcpy( pCBlock->pLocals + w, pLocal, sizeof( HB_ITEM ) ); } else { @@ -119,7 +119,7 @@ HB_CODEBLOCK_PTR hb_codeblockNew( BYTE * pBuffer, * released if other codeblock will be deleted */ hb_memvarValueIncRef( pLocal->item.asMemvar.value ); - memcpy( pCBlock->pLocals + w, pLocal, sizeof(HB_ITEM) ); + memcpy( pCBlock->pLocals + w, pLocal, sizeof( HB_ITEM ) ); } ++w; } @@ -132,15 +132,15 @@ HB_CODEBLOCK_PTR hb_codeblockNew( BYTE * pBuffer, */ PHB_ITEM pLocal; - pLocal =stack.pBase +1; + pLocal = stack.pBase + 1; if( IS_BLOCK( pLocal ) ) { - HB_CODEBLOCK_PTR pOwner =pLocal->item.asBlock.value; + HB_CODEBLOCK_PTR pOwner = pLocal->item.asBlock.value; - pCBlock->pLocals =pOwner->pLocals; - pCBlock->wLocals =wLocals =pOwner->wLocals; - if( pOwner->pLocals ) - { /* the outer codeblock have the table with local references - reuse it */ + pCBlock->pLocals = pOwner->pLocals; + pCBlock->wLocals = wLocals = pOwner->wLocals; + if( pOwner->pLocals ) + { /* the outer codeblock have the table with local references - reuse it */ while( wLocals ) { hb_memvarValueIncRef( pCBlock->pLocals[ wLocals ].item.asMemvar.value ); @@ -152,7 +152,7 @@ HB_CODEBLOCK_PTR hb_codeblockNew( BYTE * pBuffer, } } else - pCBlock->pLocals =NULL; + pCBlock->pLocals = NULL; } /* @@ -162,8 +162,8 @@ HB_CODEBLOCK_PTR hb_codeblockNew( BYTE * pBuffer, */ pCBlock->pCode = pBuffer; - pCBlock->pSymbols =pSymbols; - pCBlock->lCounter =1; + pCBlock->pSymbols = pSymbols; + pCBlock->lCounter = 1; #ifdef CODEBLOCKDEBUG printf( "\ncodeblock created (%li) %lx", pCBlock->lCounter, pCBlock ); @@ -237,7 +237,7 @@ PHB_ITEM hb_codeblockGetRef( PHB_ITEM pItem, PHB_ITEM pRefer ) { HB_CODEBLOCK_PTR pCBlock = pItem->item.asBlock.value; - return pCBlock->pLocals - pRefer->item.asRefer.value; + return pCBlock->pLocals - pRefer->item.asRefer.value; } /* Copy the codeblock diff --git a/harbour/source/rtl/console.c b/harbour/source/rtl/console.c index 3eada21f3f..b199c8fbf7 100644 --- a/harbour/source/rtl/console.c +++ b/harbour/source/rtl/console.c @@ -41,6 +41,7 @@ /* Harbour Project source code http://www.Harbour-Project.org/ The following functions are Copyright 1999 Victor Szel : + HB_SETPOSBS() HB_DISPBOX() GT version. HB_DISPBEGIN() HB_DISPEND() @@ -573,6 +574,23 @@ HARBOUR HB_SETPOS( void ) /* Sets the screen position */ hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "SETPOS" ); /* NOTE: Clipper catches this at compile time! */ } +/* Move the screen position to the right by one column */ +HARBOUR HB_SETPOSBS( void ) +{ + if( hb_pcount() == 0 ) + { + USHORT uiRow; + USHORT uiCol; + + /* NOTE: Clipper does no checks about reaching the border or anything */ + + hb_gtGetPos( &uiRow, &uiCol ); + hb_gtSetPos( uiRow, uiCol + 1 ); + } + else + hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "SETPOSBS" ); /* NOTE: Clipper catches this at compile time! */ +} + HARBOUR HB_DEVPOS( void ) /* Sets the screen and/or printer position */ { if( hb_pcount() == 2 ) diff --git a/harbour/source/rtl/dir.c b/harbour/source/rtl/dir.c index 3618bac85d..2ba4c86af0 100644 --- a/harbour/source/rtl/dir.c +++ b/harbour/source/rtl/dir.c @@ -458,6 +458,8 @@ HARBOUR HB_DIRECTORY( void ) hb_itemArrayPut( psubarray, 4, ptime ); hb_itemArrayPut( psubarray, 5, pattr ); + /* NOTE: Simply ignores the situation where the array length + limit is reached. */ hb_arrayAdd( pdir, psubarray ); hb_itemRelease( pfilename ); diff --git a/harbour/source/rtl/extend.c b/harbour/source/rtl/extend.c index 51e0f11748..154df7d3ae 100644 --- a/harbour/source/rtl/extend.c +++ b/harbour/source/rtl/extend.c @@ -36,6 +36,7 @@ #include "set.h" #include "dates.h" +/* NOTE: iParam = -1 can be used to access the return value. */ /* NOTE: iParam = 0 can be used to access the SELF object. */ PHB_ITEM hb_param( int iParam, WORD wMask ) @@ -91,11 +92,10 @@ char * hb_parc( int iParam, ... ) ULONG ulArrayIndex; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - return hb_arrayGetString( pItem, ulArrayIndex ); + return hb_arrayGetString( pItem, ulArrayIndex ); } } @@ -125,11 +125,10 @@ ULONG hb_parclen( int iParam, ... ) ULONG ulArrayIndex; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - return hb_arrayGetStringLen( pItem, ulArrayIndex ); + return hb_arrayGetStringLen( pItem, ulArrayIndex ); } } @@ -162,11 +161,10 @@ ULONG hb_parcsiz( int iParam, ... ) ULONG ulArrayIndex; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - return hb_arrayGetStringLen( pItem, ulArrayIndex ) + 1; + return hb_arrayGetStringLen( pItem, ulArrayIndex ) + 1; } } @@ -203,16 +201,13 @@ char * hb_pards( int iParam, ... ) ULONG ulArrayIndex; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - { - hb_arrayGetDate( pItem, ulArrayIndex, stack.szDate ); - stack.szDate[ 8 ] = '\0'; + hb_arrayGetDate( pItem, ulArrayIndex, stack.szDate ); + stack.szDate[ 8 ] = '\0'; - return stack.szDate; /* this guaranties good behavior when multithreading */ - } + return stack.szDate; /* this guaranties good behavior when multithreading */ } } @@ -251,11 +246,10 @@ int hb_parl( int iParam, ... ) ULONG ulArrayIndex; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - return hb_arrayGetBool( pItem, ulArrayIndex ) ? 1 : 0; + return hb_arrayGetBool( pItem, ulArrayIndex ) ? 1 : 0; } } @@ -291,11 +285,10 @@ double hb_parnd( int iParam, ... ) ULONG ulArrayIndex; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - return hb_arrayGetDouble( pItem, ulArrayIndex ); + return hb_arrayGetDouble( pItem, ulArrayIndex ); } } @@ -331,11 +324,10 @@ int hb_parni( int iParam, ... ) ULONG ulArrayIndex; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - return ( int ) hb_arrayGetDouble( pItem, ulArrayIndex ); + return ( int ) hb_arrayGetNL( pItem, ulArrayIndex ); } } @@ -374,11 +366,10 @@ long hb_parnl( int iParam, ... ) ULONG ulArrayIndex; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - return ( long ) hb_arrayGetDouble( pItem, ulArrayIndex ); + return hb_arrayGetNL( pItem, ulArrayIndex ); } } @@ -562,352 +553,197 @@ void hb_retnllen( long lNumber, WORD wWidth ) void hb_storc( char * szText, int iParam, ... ) { - if( ( iParam > 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) ) + if( iParam > 0 && iParam <= hb_pcount() ) { - PHB_ITEM pItem, pItemRef; - ULONG ulLen; - - if( iParam == -1 ) - { - pItem = &stack.Return; - ulLen = strlen( szText ); - hb_itemClear( pItem ); - pItem->type = IT_STRING; - pItem->item.asString.length = ulLen; - pItem->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 ); - strcpy( pItem->item.asString.value, szText ); - } - else - pItem = stack.pBase + 1 + iParam; + PHB_ITEM pItem = stack.pBase + 1 + iParam; if( IS_BYREF( pItem ) ) - { - ulLen = strlen( szText ); - pItemRef = hb_itemUnRef( pItem ); - hb_itemClear( pItemRef ); - pItemRef->type = IT_STRING; - pItemRef->item.asString.length = ulLen; - pItemRef->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 ); - strcpy( pItemRef->item.asString.value, szText ); - } + hb_itemPutC( hb_itemUnRef( pItem ), szText ); + else if( IS_ARRAY( pItem ) ) { va_list va; ULONG ulArrayIndex; + PHB_ITEM pItemNew; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - { - ulLen = strlen( szText ); - pItemRef = hb_itemNew( NULL ); - pItemRef->type = IT_STRING; - pItemRef->item.asString.length = ulLen; - pItemRef->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 ); - strcpy( pItemRef->item.asString.value, szText ); - hb_arraySet( pItem, ulArrayIndex, pItemRef ); - hb_itemRelease( pItemRef ); - } + pItemNew = hb_itemPutC( NULL, szText ); + hb_arraySet( pItem, ulArrayIndex, pItemNew ); + hb_itemRelease( pItemNew ); } } + else if( iParam == -1 ) + hb_itemPutC( &stack.Return, szText ); } -void hb_storclen( char * fixText, ULONG ulLen, int iParam, ... ) +void hb_storclen( char * szText, ULONG ulLen, int iParam, ... ) { - if( ( iParam > 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) ) + if( iParam > 0 && iParam <= hb_pcount() ) { - PHB_ITEM pItem, pItemRef; - - if( iParam == -1 ) - { - pItem = &stack.Return; - hb_itemClear( pItem ); - pItem->type = IT_STRING; - pItem->item.asString.length = ulLen; - pItem->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 ); - memcpy( pItem->item.asString.value, fixText, ulLen ); - pItem->item.asString.value[ ulLen ] = '\0'; - } - else - pItem = stack.pBase + 1 + iParam; + PHB_ITEM pItem = stack.pBase + 1 + iParam; if( IS_BYREF( pItem ) ) - { - pItemRef = hb_itemUnRef( pItem ); - hb_itemClear( pItemRef ); - pItemRef->type = IT_STRING; - pItemRef->item.asString.length = ulLen; - pItemRef->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 ); - memcpy( pItemRef->item.asString.value, fixText, ulLen ); - pItemRef->item.asString.value[ ulLen ] = '\0'; - } + hb_itemPutCL( hb_itemUnRef( pItem ), szText, ulLen ); + else if( IS_ARRAY( pItem ) ) { va_list va; ULONG ulArrayIndex; + PHB_ITEM pItemNew; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - { - pItemRef = hb_itemNew( NULL ); - pItemRef->type = IT_STRING; - pItemRef->item.asString.length = ulLen; - pItemRef->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 ); - memcpy( pItemRef->item.asString.value, fixText, ulLen ); - pItemRef->item.asString.value[ ulLen ] = '\0'; - hb_arraySet( pItem, ulArrayIndex, pItemRef ); - hb_itemRelease( pItemRef ); - } + pItemNew = hb_itemPutCL( NULL, szText, ulLen ); + hb_arraySet( pItem, ulArrayIndex, pItemNew ); + hb_itemRelease( pItemNew ); } } + else if( iParam == -1 ) + hb_itemPutCL( &stack.Return, szText, ulLen ); } void hb_stords( char * szDate, int iParam, ... ) /* szDate must have yyyymmdd format */ { - if( ( iParam > 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) ) + if( iParam > 0 && iParam <= hb_pcount() ) { - PHB_ITEM pItem, pItemRef; - long lDay, lMonth, lYear; - - hb_dateStrGet( szDate, &lDay, &lMonth, &lYear ); - - if( iParam == -1 ) - { - pItem = &stack.Return; - hb_itemClear( pItem ); - pItem->type = IT_DATE; - pItem->item.asDate.value = hb_dateEncode( lDay, lMonth, lYear ); - } - else - pItem = stack.pBase + 1 + iParam; + PHB_ITEM pItem = stack.pBase + 1 + iParam; if( IS_BYREF( pItem ) ) - { - pItemRef = hb_itemUnRef( pItem ); - hb_itemClear( pItemRef ); - pItemRef->type = IT_DATE; - pItemRef->item.asDate.value = hb_dateEncode( lDay, lMonth, lYear ); - } + hb_itemPutDS( hb_itemUnRef( pItem ), szDate ); + else if( IS_ARRAY( pItem ) ) { va_list va; ULONG ulArrayIndex; + PHB_ITEM pItemNew; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - { - pItemRef = hb_itemNew( NULL ); - pItemRef->type = IT_DATE; - pItemRef->item.asDate.value = hb_dateEncode( lDay, lMonth, lYear ); - hb_arraySet( pItem, ulArrayIndex, pItemRef ); - hb_itemRelease( pItemRef ); - } + pItemNew = hb_itemPutDS( NULL, szDate ); + hb_arraySet( pItem, ulArrayIndex, pItemNew ); + hb_itemRelease( pItemNew ); } } + if( iParam == -1 ) + hb_itemPutDS( &stack.Return, szDate ); } void hb_storl( int iLogical, int iParam, ... ) { - if( ( iParam > 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) ) + if( iParam > 0 && iParam <= hb_pcount() ) { - PHB_ITEM pItem, pItemRef; - - if( iParam == -1 ) - { - pItem = &stack.Return; - hb_itemClear( pItem ); - pItem->type = IT_LOGICAL; - pItem->item.asLogical.value = iLogical ? TRUE : FALSE; - } - else - pItem = stack.pBase + 1 + iParam; + PHB_ITEM pItem = stack.pBase + 1 + iParam; if( IS_BYREF( pItem ) ) - { - pItemRef = hb_itemUnRef( pItem ); - hb_itemClear( pItemRef ); - pItemRef->type = IT_LOGICAL; - pItemRef->item.asLogical.value = iLogical ? TRUE : FALSE; - } + hb_itemPutL( hb_itemUnRef( pItem ), iLogical ? TRUE : FALSE ); + else if( IS_ARRAY( pItem ) ) { va_list va; ULONG ulArrayIndex; + PHB_ITEM pItemNew; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - { - pItemRef = hb_itemNew( NULL ); - pItemRef->type = IT_LOGICAL; - pItemRef->item.asLogical.value = iLogical ? TRUE : FALSE; - hb_arraySet( pItem, ulArrayIndex, pItemRef ); - hb_itemRelease( pItemRef ); - } + pItemNew = hb_itemPutL( NULL, iLogical ? TRUE : FALSE ); + hb_arraySet( pItem, ulArrayIndex, pItemNew ); + hb_itemRelease( pItemNew ); } } + else if( iParam == -1 ) + hb_itemPutL( &stack.Return, iLogical ? TRUE : FALSE ); } void hb_storni( int iValue, int iParam, ... ) { - if( ( iParam > 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) ) + if( iParam > 0 && iParam <= hb_pcount() ) { - PHB_ITEM pItem, pItemRef; - - if( iParam == -1 ) - { - pItem = &stack.Return; - hb_itemClear( pItem ); - pItem->type = IT_INTEGER; - pItem->item.asInteger.length = 10; - pItem->item.asInteger.value = iValue; - } - else - pItem = stack.pBase + 1 + iParam; + PHB_ITEM pItem = stack.pBase + 1 + iParam; if( IS_BYREF( pItem ) ) - { - pItemRef = hb_itemUnRef( pItem ); - hb_itemClear( pItemRef ); - pItemRef->type = IT_INTEGER; - pItemRef->item.asInteger.length = 10; - pItemRef->item.asInteger.value = iValue; - } + hb_itemPutNI( hb_itemUnRef( pItem ), iValue ); + else if( IS_ARRAY( pItem ) ) { va_list va; ULONG ulArrayIndex; + PHB_ITEM pItemNew; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - { - pItemRef = hb_itemNew( NULL ); - pItemRef->type = IT_INTEGER; - pItemRef->item.asInteger.length = 10; - pItemRef->item.asInteger.value = iValue; - hb_arraySet( pItem, ulArrayIndex, pItemRef ); - hb_itemRelease( pItemRef ); - } + pItemNew = hb_itemPutNI( NULL, iValue ); + hb_arraySet( pItem, ulArrayIndex, pItemNew ); + hb_itemRelease( pItemNew ); } } + else if( iParam == -1 ) + hb_itemPutNI( &stack.Return, iValue ); } void hb_stornl( long lValue, int iParam, ... ) { - if( ( iParam > 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) ) + if( iParam > 0 && iParam <= hb_pcount() ) { - PHB_ITEM pItem, pItemRef; - - if( iParam == -1 ) - { - pItem = &stack.Return; - hb_itemClear( pItem ); - pItem->type = IT_LONG; - pItem->item.asLong.length = 10; - pItem->item.asLong.value = lValue; - } - else - pItem = stack.pBase + 1 + iParam; + PHB_ITEM pItem = stack.pBase + 1 + iParam; if( IS_BYREF( pItem ) ) - { - pItemRef = hb_itemUnRef( pItem ); - hb_itemClear( pItemRef ); - pItemRef->type = IT_LONG; - pItemRef->item.asLong.length = 10; - pItemRef->item.asLong.value = lValue; - } + hb_itemPutNI( hb_itemUnRef( pItem ), lValue ); + else if( IS_ARRAY( pItem ) ) { va_list va; ULONG ulArrayIndex; + PHB_ITEM pItemNew; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - { - pItemRef = hb_itemNew( NULL ); - pItemRef->type = IT_LONG; - pItemRef->item.asLong.length = 10; - pItemRef->item.asLong.value = lValue; - hb_arraySet( pItem, ulArrayIndex, pItemRef ); - hb_itemRelease( pItemRef ); - } + pItemNew = hb_itemPutNL( NULL, lValue ); + hb_arraySet( pItem, ulArrayIndex, pItemNew ); + hb_itemRelease( pItemNew ); } } + else if( iParam == -1 ) + hb_itemPutNL( &stack.Return, lValue ); } void hb_stornd( double dValue, int iParam, ... ) { - if( ( iParam > 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) ) + if( iParam > 0 && iParam <= hb_pcount() ) { - PHB_ITEM pItem, pItemRef; - - if( iParam == -1 ) - { - pItem = &stack.Return; - hb_itemClear( pItem ); - pItem->type = IT_DOUBLE; - if( dValue > 10000000000.0 ) - pItem->item.asDouble.length = 20; - else - pItem->item.asDouble.length = 10; - pItem->item.asDouble.decimal = hb_set.HB_SET_DECIMALS; - pItem->item.asDouble.value = dValue; - } - else - pItem = stack.pBase + 1 + iParam; + PHB_ITEM pItem = stack.pBase + 1 + iParam; if( IS_BYREF( pItem ) ) - { - pItemRef = hb_itemUnRef( pItem ); - hb_itemClear( pItemRef ); - pItemRef->type = IT_DOUBLE; - if( dValue > 10000000000.0 ) - pItemRef->item.asDouble.length = 20; - else - pItemRef->item.asDouble.length = 10; - pItemRef->item.asDouble.decimal = hb_set.HB_SET_DECIMALS; - pItemRef->item.asDouble.value = dValue; - } + hb_itemPutNI( hb_itemUnRef( pItem ), dValue ); + else if( IS_ARRAY( pItem ) ) { va_list va; ULONG ulArrayIndex; + PHB_ITEM pItemNew; va_start( va, iParam ); - ulArrayIndex = va_arg( va, long ); + ulArrayIndex = va_arg( va, ULONG ); va_end( va ); - if( ulArrayIndex != 0 ) - { - pItemRef = hb_itemNew( NULL ); - pItemRef->type = IT_DOUBLE; - if( dValue > 10000000000.0 ) - pItemRef->item.asDouble.length = 20; - else - pItemRef->item.asDouble.length = 10; - pItemRef->item.asDouble.decimal = hb_set.HB_SET_DECIMALS; - pItemRef->item.asDouble.value = dValue; - hb_arraySet( pItem, ulArrayIndex, pItemRef ); - hb_itemRelease( pItemRef ); - } + pItemNew = hb_itemPutND( NULL, dValue ); + hb_arraySet( pItem, ulArrayIndex, pItemNew ); + hb_itemRelease( pItemNew ); } } + else if( iParam == -1 ) + hb_itemPutND( &stack.Return, dValue ); } diff --git a/harbour/source/rtl/itemapi.c b/harbour/source/rtl/itemapi.c index b6a5d2025a..f3d30ed2b7 100644 --- a/harbour/source/rtl/itemapi.c +++ b/harbour/source/rtl/itemapi.c @@ -25,6 +25,8 @@ /* Harbour Project source code http://www.Harbour-Project.org/ The following functions are Copyright 1999 Victor Szel : + hb_itemPutNI() + hb_itemGetNI() hb_itemGetCLen() hb_itemGetNLen() hb_itemSetNLen() @@ -177,14 +179,16 @@ PHB_ITEM hb_itemArrayGet( PHB_ITEM pArray, ULONG ulIndex ) { PHB_ITEM pItem = hb_itemNew( NULL ); - hb_arrayGet( pArray, ulIndex, pItem ); + if( pArray ) + hb_arrayGet( pArray, ulIndex, pItem ); return pItem; } PHB_ITEM hb_itemArrayPut( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ) { - hb_arraySet( pArray, ulIndex, pItem ); + if( pArray ) + hb_arraySet( pArray, ulIndex, pItem ); return pArray; } @@ -204,7 +208,7 @@ PHB_ITEM hb_itemPutC( PHB_ITEM pItem, char * szText ) return pItem; } -PHB_ITEM hb_itemPutCL( PHB_ITEM pItem, char * nszText, ULONG ulLen ) +PHB_ITEM hb_itemPutCL( PHB_ITEM pItem, char * szText, ULONG ulLen ) { if( pItem ) hb_itemClear( pItem ); @@ -214,7 +218,7 @@ PHB_ITEM hb_itemPutCL( PHB_ITEM pItem, char * nszText, ULONG ulLen ) pItem->type = IT_STRING; pItem->item.asString.length = ulLen; pItem->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 ); - memcpy( pItem->item.asString.value, nszText, ulLen ); + memcpy( pItem->item.asString.value, szText, ulLen ); pItem->item.asString.value[ ulLen ] = '\0'; return pItem; @@ -328,6 +332,26 @@ double hb_itemGetND( PHB_ITEM pItem ) return 0; } +int hb_itemGetNI( PHB_ITEM pItem ) +{ + if( pItem ) + { + switch( pItem->type ) + { + case IT_INTEGER: + return pItem->item.asInteger.value; + + case IT_LONG: + return ( int ) pItem->item.asLong.value; + + case IT_DOUBLE: + return ( int ) pItem->item.asDouble.value; + } + } + + return 0; +} + long hb_itemGetNL( PHB_ITEM pItem ) { if( pItem ) @@ -370,7 +394,6 @@ PHB_ITEM hb_itemPutDS( PHB_ITEM pItem, char * szDate ) hb_dateStrGet( szDate, &lDay, &lMonth, &lYear ); - hb_itemClear( pItem ); pItem->type = IT_DATE; pItem->item.asDate.value = hb_dateEncode( lDay, lMonth, lYear ); @@ -406,6 +429,20 @@ PHB_ITEM hb_itemPutND( PHB_ITEM pItem, double dNumber ) return pItem; } +PHB_ITEM hb_itemPutNI( PHB_ITEM pItem, int iNumber ) +{ + if( pItem ) + hb_itemClear( pItem ); + else + pItem = hb_itemNew( NULL ); + + pItem->type = IT_INTEGER; + pItem->item.asInteger.length = 10; + pItem->item.asInteger.value = iNumber; + + return pItem; +} + PHB_ITEM hb_itemPutNL( PHB_ITEM pItem, long lNumber ) { if( pItem ) @@ -514,9 +551,8 @@ void hb_itemClear( PHB_ITEM pItem ) hb_arrayRelease( pItem ); } else if( IS_BLOCK( pItem ) ) - { hb_codeblockDelete( pItem ); - } + else if( IS_MEMVAR( pItem ) ) hb_memvarValueDecRef( pItem->item.asMemvar.value ); @@ -531,9 +567,7 @@ void hb_itemCopy( PHB_ITEM pDest, PHB_ITEM pSource ) hb_itemClear( pDest ); if( pDest == pSource ) - { hb_errInternal( 9999, "An item was going to be copied to itself from hb_itemCopy()", NULL, NULL ); - } memcpy( pDest, pSource, sizeof( HB_ITEM ) ); @@ -548,13 +582,10 @@ void hb_itemCopy( PHB_ITEM pDest, PHB_ITEM pSource ) ( pSource->item.asArray.value )->wHolders++; else if( IS_BLOCK( pSource ) ) - { hb_codeblockCopy( pDest, pSource ); - } + else if( IS_MEMVAR( pSource ) ) - { hb_memvarValueIncRef( pSource->item.asMemvar.value ); - } } /* Internal API, not standard Clipper */ diff --git a/harbour/source/rtl/set.c b/harbour/source/rtl/set.c index a02a266eea..315b0be9ff 100644 --- a/harbour/source/rtl/set.c +++ b/harbour/source/rtl/set.c @@ -240,7 +240,7 @@ static void close_text( FHANDLE handle ) } } -static FHANDLE open_handle( char * file_name, BOOL bMode, char * def_ext, HB_set_enum set_specifier ) +static FHANDLE open_handle( char * file_name, BOOL bAppend, char * def_ext, HB_set_enum set_specifier ) { FHANDLE handle; PHB_FNAME pFilename; @@ -258,13 +258,13 @@ static FHANDLE open_handle( char * file_name, BOOL bMode, char * def_ext, HB_set hb_fsFNameMerge( path, pFilename ); hb_xfree( pFilename ); - /* Open the file either in append (bMode) or truncate mode (!bMode), but + /* Open the file either in append (bAppend) or truncate mode (!bAppend), but always use binary mode */ /* QUESTION: What sharing mode does Clipper use ? [vszel] */ - while( ( handle = ( bMode ? hb_fsOpen( (BYTE *)path, FO_WRITE | FO_DENYWRITE ) : - hb_fsCreate( (BYTE *)path, FC_NORMAL ) ) ) == FS_ERROR ) + while( ( handle = ( bAppend ? hb_fsOpen( (BYTE *)path, FO_WRITE | FO_DENYWRITE ) : + hb_fsCreate( (BYTE *)path, FC_NORMAL ) ) ) == FS_ERROR ) { WORD wResult; diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 8af18c9967..6d920432f1 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -1065,26 +1065,6 @@ void hb_vmDuplTwo( void ) hb_stackPush(); } -HARBOUR HB_EVAL( void ) -{ - PHB_ITEM pBlock = hb_param( 1, IT_BLOCK ); - - if( pBlock ) - { - WORD w; - - hb_vmPushSymbol( &symEval ); - hb_vmPush( pBlock ); - - for( w = 2; w <= hb_pcount(); w++ ) - hb_vmPush( hb_param( w, IT_ANY ) ); - - hb_vmDo( hb_pcount() - 1 ); - } - else - hb_errInternal( 9999, "Not a valid codeblock on EVAL", NULL, NULL ); -} - void hb_vmEndBlock( void ) { hb_stackDec(); /* make the last item visible */ @@ -1257,7 +1237,7 @@ void hb_vmGreater( void ) hb_vmPushLogical( lDate1 > lDate2 ); } - else if( IS_LOGICAL( stack.pPos - 1 ) && IS_LOGICAL( stack.pPos -2 ) ) + else if( IS_LOGICAL( stack.pPos - 1 ) && IS_LOGICAL( stack.pPos - 2 ) ) { BOOL bLogical2 = hb_vmPopLogical(); BOOL bLogical1 = hb_vmPopLogical(); @@ -1302,7 +1282,7 @@ void hb_vmGreaterEqual( void ) hb_vmPushLogical( lDate1 >= lDate2 ); } - else if( IS_LOGICAL( stack.pPos - 1 ) && IS_LOGICAL( stack.pPos -2 ) ) + else if( IS_LOGICAL( stack.pPos - 1 ) && IS_LOGICAL( stack.pPos - 2 ) ) { BOOL bLogical2 = hb_vmPopLogical(); BOOL bLogical1 = hb_vmPopLogical(); @@ -1398,7 +1378,7 @@ void hb_vmLess( void ) hb_vmPushLogical( lDate1 < lDate2 ); } - else if( IS_LOGICAL( stack.pPos - 1 ) && IS_LOGICAL( stack.pPos -2 ) ) + else if( IS_LOGICAL( stack.pPos - 1 ) && IS_LOGICAL( stack.pPos - 2 ) ) { BOOL bLogical2 = hb_vmPopLogical(); BOOL bLogical1 = hb_vmPopLogical(); @@ -2576,8 +2556,8 @@ void hb_vmStatics( PHB_SYMB pSym ) /* initializes the global aStatics array or r */ static void hb_vmSwapAlias( void ) { - HB_ITEM_PTR pItem = stack.pPos -1; - HB_ITEM_PTR pWorkArea = stack.pPos -2; + HB_ITEM_PTR pItem = stack.pPos - 1; + HB_ITEM_PTR pWorkArea = stack.pPos - 2; switch( pWorkArea->type & ~IT_BYREF ) { @@ -2812,6 +2792,33 @@ void hb_vmForceLink( void ) /* ----------------------------- */ /* TODO: Put these to /source/rtl/?.c */ +HARBOUR HB_EVAL( void ) +{ + WORD wPCount = hb_pcount(); + + if( wPCount >= 1 ) + { + PHB_ITEM pBlock = hb_param( 1, IT_BLOCK ); + + if( pBlock ) + { + WORD wParam; + + hb_vmPushSymbol( &symEval ); + hb_vmPush( pBlock ); + + for( wParam = 2; wParam <= wPCount; wParam++ ) + hb_vmPush( hb_param( wParam, IT_ANY ) ); + + hb_vmDo( wPCount - 1 ); + } + else + hb_errInternal( 9999, "Not a valid codeblock on EVAL", NULL, NULL ); + } + else + hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "EVAL" ); /* NOTE: Clipper catches this at compile time! */ +} + HARBOUR HB_LEN( void ) { if( hb_pcount() == 1 ) diff --git a/harbour/tests/working/ifelse.prg b/harbour/tests/working/ifelse.prg index e78635f38a..351605f851 100644 --- a/harbour/tests/working/ifelse.prg +++ b/harbour/tests/working/ifelse.prg @@ -6,9 +6,16 @@ function Main() - local x := 3 // change this value from 1 to 5 and see the results! + local i QOut( "Testing Harbour If elseif else endif" ) + for i := 1 to 5 + TestValue( i ) + next + +return nil + +function TestValue( x ) if x = 1 QOut( "x is 1" ) diff --git a/harbour/tests/working/rtl_test.prg b/harbour/tests/working/rtl_test.prg index 454ef83eae..957925f95f 100644 --- a/harbour/tests/working/rtl_test.prg +++ b/harbour/tests/working/rtl_test.prg @@ -265,38 +265,6 @@ FUNCTION Main( cPar1 ) 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 */ - TEST_LINE( Descend( NIL ) , NIL ) - TEST_LINE( Descend( { "A", "B" } ) , NIL ) - TEST_LINE( Descend( @lcString ) , NIL ) - TEST_LINE( Descend( lcString ) , "¸»´´±" ) - TEST_LINE( Descend( lcString ) , "¸»´´±" ) - TEST_LINE( Descend( Descend( lcString ) ) , "HELLO" ) - TEST_LINE( Descend( .F. ) , .T. ) - TEST_LINE( Descend( .T. ) , .F. ) - TEST_LINE( Descend( 0 ) , 0.00 ) - TEST_LINE( Descend( 1 ) , -1.00 ) - TEST_LINE( Descend( -1 ) , 1.00 ) - TEST_LINE( Descend( Descend( 256 ) ) , 256.00 ) - TEST_LINE( Descend( 2.0 ) , -2.00 ) - TEST_LINE( Descend( 2.5 ) , -2.50 ) - TEST_LINE( Descend( -100.35 ) , 100.35 ) - TEST_LINE( Str(Descend( -740.354 )) , " 740.35" ) - TEST_LINE( Str(Descend( -740.359 )) , " 740.36" ) - TEST_LINE( Str(Descend( -740.354 ), 15, 5) , " 740.35400" ) - TEST_LINE( Str(Descend( -740.359 ), 15, 5) , " 740.35900" ) - TEST_LINE( Descend( 100000 ) , -100000.00 ) - TEST_LINE( Descend( -100000 ) , 100000.00 ) - TEST_LINE( Descend( "" ) , "" ) - TEST_LINE( Descend( Chr(0) ) , ""+Chr(0)+"" ) - TEST_LINE( Descend( Chr(0) + "Hello" ) , ""+Chr(0)+"¸›””‘" ) - TEST_LINE( Descend( "Hello"+Chr(0)+"wo" ) , "¸›””‘"+Chr(0)+"‰‘" ) - TEST_LINE( Descend( SToD( "" ) ) , 5231808 ) - TEST_LINE( Descend( SToD( "01000101" ) ) , 3474223 ) - TEST_LINE( Descend( SToD( "19801220" ) ) , 2787214 ) - /* (operators) */ TEST_LINE( 2 <= 1 , .F. ) @@ -393,7 +361,7 @@ FUNCTION Main( cPar1 ) TEST_LINE( .T. .AND. SToD("") , SToD(" ") ) TEST_LINE( .T. .AND. NIL , NIL ) TEST_LINE( .T. .AND. {} , "{.[0].}" ) - TEST_LINE( .T. .AND. {|| NIL } , "{||...}" ) +// TEST_LINE( .T. .AND. {|| NIL } , "{||...}" ) TEST_LINE( .F. .AND. 1 , .F. ) TEST_LINE( .F. .AND. 1.567 , .F. ) TEST_LINE( .F. .AND. lcString , .F. ) @@ -429,7 +397,7 @@ FUNCTION Main( cPar1 ) TEST_LINE( .T. .AND. SToD("") , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( .T. .AND. NIL , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( .T. .AND. {} , "E BASE 1078 Argument error .AND. F:S" ) - TEST_LINE( .T. .AND. {|| NIL } , "E BASE 1078 Argument error .AND. F:S" ) +// TEST_LINE( .T. .AND. {|| NIL } , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( .F. .AND. 1 , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( .F. .AND. 1.567 , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( .F. .AND. lcString , "E BASE 1078 Argument error .AND. F:S" ) @@ -480,7 +448,7 @@ 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( {|| NIL } == {|| NIL } , "E BASE 1070 Argument error == F:S" ) +// 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" ) @@ -498,13 +466,13 @@ FUNCTION Main( cPar1 ) TEST_CALL( '("NOTHERE")->NOFIELD', {|| ("NOTHERE")->NOFIELD }, "E BASE 1002 Alias does not exist NOTHERE F:R" ) TEST_CALL( '(mcString)->NOFIELD' , {|| (mcString)->NOFIELD } , "E BASE 1002 Alias does not exist HELLO F:R" ) TEST_CALL( '({})->NOFIELD' , {|| ({})->NOFIELD } , "E BASE 1065 Argument error & F:S" ) - TEST_CALL( '({|| NIL })->NOFIELD', {|| ({|| NIL })->NOFIELD }, "E BASE 1065 Argument error & F:S" ) +// TEST_CALL( '({|| NIL })->NOFIELD', {|| ({|| NIL })->NOFIELD }, "E BASE 1065 Argument error & F:S" ) TEST_CALL( '(.T.)->NOFIELD' , {|| (.T.)->NOFIELD } , "E BASE 1065 Argument error & F:S" ) TEST_CALL( '(NIL)->NOFIELD' , {|| (NIL)->NOFIELD } , "E BASE 1065 Argument error & F:S" ) TEST_CALL( '("NOTHERE")->(Eof())', {|| ("NOTHERE")->(Eof()) }, .T. ) TEST_CALL( '(mcString)->(Eof())' , {|| (mcString)->(Eof()) } , .T. ) TEST_CALL( '({})->(Eof())' , {|| ({})->(Eof()) } , .T. ) - TEST_CALL( '({|| NIL })->(Eof())', {|| ({|| NIL })->(Eof()) }, .T. ) +// TEST_CALL( '({|| NIL })->(Eof())', {|| ({|| NIL })->(Eof()) }, .T. ) TEST_CALL( '(.T.)->(Eof())' , {|| (.T.)->(Eof()) } , .T. ) TEST_CALL( '(.F.)->(Eof())' , {|| (.F.)->(Eof()) } , .T. ) TEST_CALL( '(NIL)->(Eof())' , {|| (NIL)->(Eof()) } , .T. ) @@ -515,7 +483,7 @@ FUNCTION Main( cPar1 ) TEST_LINE( 200->(1) , 1 ) TEST_LINE( 200->(1.5) , 1.5 ) TEST_LINE( 200->({}) , "{.[0].}" ) - TEST_LINE( 200->({|| NIL }) , "{||...}" ) +// TEST_LINE( 200->({|| NIL }) , "{||...}" ) TEST_LINE( 200->(.T.) , .T. ) #endif @@ -571,7 +539,7 @@ FUNCTION Main( cPar1 ) TEST_LINE( Empty( {1} ) , .F. ) TEST_LINE( Empty( {} ) , .T. ) TEST_LINE( Empty( {0} ) , .F. ) - TEST_LINE( Empty( {|x|x+x} ) , .F. ) +// TEST_LINE( Empty( {|x|x+x} ) , .F. ) /* ABS() */ @@ -1106,6 +1074,38 @@ FUNCTION Main( cPar1 ) TEST_LINE( Transform( 0 , "@BZ 9999" ) , " " ) TEST_LINE( Transform( 2334 , "Xxxxx: #####") , "Xxxxx: 2334" ) + /* DESCEND() */ + + TEST_LINE( Descend() , NIL ) /* Bug in CA-Cl*pper, it returns undefined trash */ + TEST_LINE( Descend( NIL ) , NIL ) + TEST_LINE( Descend( { "A", "B" } ) , NIL ) + TEST_LINE( Descend( @lcString ) , NIL ) + TEST_LINE( Descend( lcString ) , "¸»´´±" ) + TEST_LINE( Descend( lcString ) , "¸»´´±" ) + TEST_LINE( Descend( Descend( lcString ) ) , "HELLO" ) + TEST_LINE( Descend( .F. ) , .T. ) + TEST_LINE( Descend( .T. ) , .F. ) + TEST_LINE( Descend( 0 ) , 0.00 ) + TEST_LINE( Descend( 1 ) , -1.00 ) + TEST_LINE( Descend( -1 ) , 1.00 ) + TEST_LINE( Descend( Descend( 256 ) ) , 256.00 ) + TEST_LINE( Descend( 2.0 ) , -2.00 ) + TEST_LINE( Descend( 2.5 ) , -2.50 ) + TEST_LINE( Descend( -100.35 ) , 100.35 ) + TEST_LINE( Str(Descend( -740.354 )) , " 740.35" ) + TEST_LINE( Str(Descend( -740.359 )) , " 740.36" ) + TEST_LINE( Str(Descend( -740.354 ), 15, 5) , " 740.35400" ) + TEST_LINE( Str(Descend( -740.359 ), 15, 5) , " 740.35900" ) + TEST_LINE( Descend( 100000 ) , -100000.00 ) + TEST_LINE( Descend( -100000 ) , 100000.00 ) + TEST_LINE( Descend( "" ) , "" ) + TEST_LINE( Descend( Chr(0) ) , ""+Chr(0)+"" ) + TEST_LINE( Descend( Chr(0) + "Hello" ) , ""+Chr(0)+"¸›””‘" ) + TEST_LINE( Descend( "Hello"+Chr(0)+"wo" ) , "¸›””‘"+Chr(0)+"‰‘" ) + TEST_LINE( Descend( SToD( "" ) ) , 5231808 ) + TEST_LINE( Descend( SToD( "01000101" ) ) , 3474223 ) + TEST_LINE( Descend( SToD( "19801220" ) ) , 2787214 ) + /* Show results, return ERRORLEVEL and exit */ TEST_END()