fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

19990903-15:30 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-09-03 13:55:24 +00:00
parent c45ab10529
commit 7d2df1c895
16 changed files with 699 additions and 678 deletions
Download Patch File Download Diff File Expand all files Collapse all files

71
harbour/ChangeLog
View File

@@ -1,3 +1,74 @@
19990903-15:30 GMT+1 Victor Szel <info@szelvesz.hu>
* 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 <rglab@imid.med.pl>
*source/rtl/codebloc.c

1
harbour/funclist.txt
View File

@@ -216,6 +216,7 @@ SETCURSOR ;S;
SETKEY ;R;
SETMODE ;N;
SETPOS ;R;
SETPOSBS ;R;
SETPRC ;R;
SOUNDEX ;S;
SPACE ;R;

26
harbour/include/extend.h
View File

@@ -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 */

12
harbour/include/itemapi.h
View File

@@ -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 );

134
harbour/source/compiler/harbour.y
View File

@@ -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 ];

500
harbour/source/rtl/arrays.c
View File

@@ -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 );

2
harbour/source/rtl/classes.c
View File

@@ -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 */

44
harbour/source/rtl/codebloc.c
View File

@@ -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

18
harbour/source/rtl/console.c
View File

@@ -41,6 +41,7 @@
/* Harbour Project source code
http://www.Harbour-Project.org/
The following functions are Copyright 1999 Victor Szel <info@szelvesz.hu>:
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 )

2
harbour/source/rtl/dir.c
View File

@@ -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 );

358
harbour/source/rtl/extend.c
View File

@@ -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 );
}

57
harbour/source/rtl/itemapi.c
View File

@@ -25,6 +25,8 @@
/* Harbour Project source code
http://www.Harbour-Project.org/
The following functions are Copyright 1999 Victor Szel <info@szelvesz.hu>:
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 */

8
harbour/source/rtl/set.c
View File

@@ -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;

57
harbour/source/vm/hvm.c
View File

@@ -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 )

9
harbour/tests/working/ifelse.prg
View File

@@ -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" )

78
harbour/tests/working/rtl_test.prg
View File

@@ -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()