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

19990902-12:20 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-09-02 10:49:57 +00:00
parent fba3f32f91
commit f311dc1f93
15 changed files with 308 additions and 280 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
harbour/ChangeLog
View File

@@ -1,3 +1,46 @@
19990902-12:20 GMT+1 Victor Szel <info@szelvesz.hu>
* tests/working/rtl_test.prg
+ STOD() tests added.
* source/rtl/dir.c
* Direct stack access changed to hb_itemReturn().
* source/rtl/hvm.c
! hb_vmEqual(), hb_vmNotEqual() didn't handle DATE type. Fixed.
% hb_vmEqual(), hb_vmNotEqual() reordered the order of type to be a bit
more efficient.
% hb_vmEqual(), hb_vmNotEqual(), hb_vmGreater*(), hb_vmLess*() function
variable scopes optimed. They need less stack space now.
* source/rtl/errorapi.c
funclist.txt
+ First pass of DOSERROR() implementation.
* source/rtl/dates.c
source/rtl/extend.c
source/rtl/itemapi.c
+ hb_dateStrPut() now takes care of filling the target with spaces when
the date is empty, so from now on the caller shouldn't bother with this.
This has also fixed a possible bug in RDD/PutValue with empty date.
* source/rtl/itemapi.c
include/itemapi.h
+ hb_itemGetCLen() function added, which simply returns the length of
STRING item, arrays.c uses it right now.
* source/rtl/arrays.c
* Many stack.return accesses converted to use hb_itemReturn().
* One hb_itemClear()/hb_xfree() call pair converted to hb_itemRelease().
% Replaced internal hb_arrayLen() calls with direct access to the
array structure.
* hb_arrayGet*() functions will call the proper Item API function instead
of repeating the functionality.
* source/rtl/console.c
* hb_fsSetMode() -> hb_fsSetDevMode()
* include/filesys.h
source/filesys.c
+ hb_fsSetError() added, to be able to get/set the last error number
in internal functions which uses the FS API.
* hb_fsSetMode() -> hb_fsSetDevMode()
* source/rtl/descend.c
- One obsolete comment removed.
* source/rtl/console.c
! Some formatting errors removed.
19990901-21:24 EDT Paul Tucker <ptucker@sympatico.ca>
* source/rtl/filesys.c
* hb_fsReadLarge() -> drop out on eof
@@ -26,7 +69,7 @@
! hb_setRelease() called close_binary() instead of close_text() for
hb_set_extrahan. Fixed.
- Removed a bunch of (now) unneeded include files and OS branched.
Source look kind of clean now.
Source looks kind of clean now.
* config/rules.cf
make_tpl.*
+ Added the L_USR variable, to make it possible to pass custom parameters

2
harbour/funclist.txt
View File

@@ -96,7 +96,7 @@ DISPBOX ;R;
DISPCOUNT ;S;
DISPEND ;S;
DISPOUT ;R;
DOSERROR ;N;
DOSERROR ;S;
DOW ;R;
DTOC ;R;
DTOS ;R;

3
harbour/include/filesys.h
View File

@@ -70,6 +70,7 @@ extern BYTE * hb_fsCurDir ( USHORT uiDrive );
extern BYTE hb_fsCurDrv ( void );
extern int hb_fsDelete ( BYTE * pFilename );
extern USHORT hb_fsError ( void );
extern void hb_fsSetError ( USHORT uiError );
extern FHANDLE hb_fsExtOpen ( BYTE * pFilename, BYTE * pDefExt,
USHORT uiFlags, BYTE * pPaths, PHB_ITEM pError );
extern USHORT hb_fsIsDrv ( BYTE nDrive );
@@ -82,7 +83,7 @@ extern ULONG hb_fsReadLarge ( FHANDLE hFileHandle, BYTE * pBuff, ULONG ulCou
extern BOOL hb_fsRmDir ( BYTE * pDirName );
extern int hb_fsRename ( BYTE * pOldName, BYTE * pNewName );
extern ULONG hb_fsSeek ( FHANDLE hFileHandle, LONG lOffset, USHORT uiMode );
extern void hb_fsSetMode ( FHANDLE hFileHandle, USHORT uiMode );
extern void hb_fsSetDevMode ( FHANDLE hFileHandle, USHORT uiDevMode );
extern USHORT hb_fsWrite ( FHANDLE hFileHandle, BYTE * pBuff, USHORT ulCount );
extern ULONG hb_fsWriteLarge ( FHANDLE hFileHandle, BYTE * pBuff, ULONG ulCount );

1
harbour/include/itemapi.h
View File

@@ -47,6 +47,7 @@ extern PHB_ITEM hb_itemArrayPut ( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem
extern ULONG hb_itemCopyC ( PHB_ITEM pItem, char *szBuffer, ULONG ulLen );
extern BOOL hb_itemFreeC ( char *szText );
extern char * hb_itemGetC ( PHB_ITEM pItem );
extern ULONG hb_itemGetCLen ( PHB_ITEM pItem );
extern char * hb_itemGetDS ( PHB_ITEM pItem, char *szDate );
extern BOOL hb_itemGetL ( PHB_ITEM pItem );
extern double hb_itemGetND ( PHB_ITEM pItem );

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

@@ -66,20 +66,8 @@ char * hb_arrayGetDate( PHB_ITEM pArray, ULONG ulIndex, char * szDate )
{
if( IS_ARRAY( pArray ) )
{
if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) )
{
PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1;
if( IS_DATE( pItem ) && pItem->item.asDate.value > 0 )
{
long lDay, lMonth, lYear;
hb_dateDecode( pItem->item.asDate.value, &lDay, &lMonth, &lYear );
hb_dateStrPut( szDate, lDay, lMonth, lYear );
}
else
memset( szDate, ' ', 8 );
}
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
hb_itemGetDS( pArray->item.asArray.value->pItems + ulIndex - 1, szDate );
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) );
}
@@ -93,22 +81,8 @@ BOOL hb_arrayGetBool( PHB_ITEM pArray, ULONG ulIndex )
{
if( IS_ARRAY( pArray ) )
{
if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) )
{
PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1;
if( IS_LOGICAL( pItem ) )
return pItem->item.asLogical.value;
else if( IS_INTEGER( pItem ) )
return pItem->item.asInteger.value != 0;
else if( IS_LONG( pItem ) )
return pItem->item.asLong.value != 0;
else if( IS_DOUBLE( pItem ) )
return pItem->item.asDouble.value != 0.0;
}
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
return hb_itemGetL( pArray->item.asArray.value->pItems + ulIndex - 1 );
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) );
}
@@ -122,22 +96,8 @@ double hb_arrayGetDouble( PHB_ITEM pArray, ULONG ulIndex )
{
if( IS_ARRAY( pArray ) )
{
if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) )
{
PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1;
if( IS_INTEGER( pItem ) )
return pItem->item.asInteger.value;
else if( IS_LONG( pItem ) )
return pItem->item.asLong.value;
else if( IS_DOUBLE( pItem ) )
return pItem->item.asDouble.value;
else if( IS_DATE( pItem ) )
return pItem->item.asDate.value;
}
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
return hb_itemGetND( pArray->item.asArray.value->pItems + ulIndex - 1 );
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) );
}
@@ -151,7 +111,7 @@ double hb_arrayGetDouble( PHB_ITEM pArray, ULONG ulIndex )
void hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ) /* creates a new array */
{
PBASEARRAY pBaseArray = ( PBASEARRAY ) hb_xgrab( sizeof( BASEARRAY ) );
ULONG ul;
ULONG ulPos;
hb_itemClear( pItem );
@@ -167,8 +127,8 @@ void hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ) /* creates a new array */
pBaseArray->wClass = 0;
pBaseArray->bSuperCast = FALSE;
for( ul = 0; ul < ulLen; ul++ )
( pBaseArray->pItems + ul )->type = IT_NIL;
for( ulPos = 0; ulPos < ulLen; ulPos++ )
( pBaseArray->pItems + ulPos )->type = IT_NIL;
pItem->item.asArray.value = pBaseArray;
}
@@ -191,7 +151,7 @@ void hb_arrayGet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem )
{
if( IS_ARRAY( pArray ) )
{
if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) )
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
hb_itemCopy( pItem, pArray->item.asArray.value->pItems + ( ulIndex - 1 ) );
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) );
@@ -204,7 +164,7 @@ char * hb_arrayGetString( PHB_ITEM pArray, ULONG ulIndex )
{
if( IS_ARRAY( pArray ) )
{
if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) )
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
{
PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1;
@@ -224,13 +184,8 @@ ULONG hb_arrayGetStringLen( PHB_ITEM pArray, ULONG ulIndex )
{
if( IS_ARRAY( pArray ) )
{
if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) )
{
PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1;
if( IS_STRING( pItem ) )
return pItem->item.asString.length;
}
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
return hb_itemGetCLen( pArray->item.asArray.value->pItems + ulIndex - 1 );
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) );
}
@@ -244,11 +199,8 @@ int hb_arrayGetType( PHB_ITEM pArray, ULONG ulIndex )
{
if( IS_ARRAY( pArray ) )
{
if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) )
{
PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1;
return pItem->type;
}
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
return hb_itemType( pArray->item.asArray.value->pItems + ulIndex - 1 );
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) );
}
@@ -281,7 +233,7 @@ void hb_arraySet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem )
{
if( IS_ARRAY( pArray ) )
{
if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) )
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
hb_itemCopy( pArray->item.asArray.value->pItems + ( ulIndex - 1 ), pItem );
else
hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ) );
@@ -295,13 +247,13 @@ void hb_arraySize( PHB_ITEM pArray, ULONG ulLen )
if( IS_ARRAY( pArray ) )
{
PBASEARRAY pBaseArray = pArray->item.asArray.value;
ULONG ul;
ULONG ulPos;
if( ! pBaseArray->ulLen )
{
pBaseArray->pItems = ( PHB_ITEM ) hb_xgrab( ulLen * sizeof( HB_ITEM ) );
for( ul = 0; ul < ulLen; ul ++ )
( pBaseArray->pItems + ul )->type = IT_NIL;
for( ulPos = 0; ulPos < ulLen; ulPos++ )
( pBaseArray->pItems + ulPos )->type = IT_NIL;
}
else
{
@@ -310,14 +262,14 @@ void hb_arraySize( PHB_ITEM pArray, ULONG ulLen )
pBaseArray->pItems = ( PHB_ITEM ) hb_xrealloc( pBaseArray->pItems, sizeof( HB_ITEM ) * ulLen );
/* set value for new items */
for( ul = pBaseArray->ulLen; ul < ulLen; ul++ )
( pBaseArray->pItems + ul )->type = IT_NIL;
for( ulPos = pBaseArray->ulLen; ulPos < ulLen; ulPos++ )
( pBaseArray->pItems + ulPos )->type = IT_NIL;
}
else if( pBaseArray->ulLen > ulLen )
{
/* release old items */
for( ul = ulLen; ul < pBaseArray->ulLen; ul++ )
hb_itemClear( pBaseArray->pItems + ul );
for( ulPos = ulLen; ulPos < pBaseArray->ulLen; ulPos++ )
hb_itemClear( pBaseArray->pItems + ulPos );
pBaseArray->pItems = ( PHB_ITEM ) hb_xrealloc( pBaseArray->pItems, sizeof( HB_ITEM ) * ulLen );
}
@@ -330,8 +282,8 @@ void hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCoun
{
if( IS_ARRAY( pArray ) )
{
PBASEARRAY pBaseArray;
ULONG ulLen = hb_arrayLen( pArray );
PBASEARRAY pBaseArray = pArray->item.asArray.value;
ULONG ulLen = pBaseArray->ulLen;
if( ulStart == 0 ) /* if parameter is missing */
ulStart = 1;
@@ -342,9 +294,7 @@ void hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCoun
if( ulStart + ulCount > ulLen ) /* check range */
ulCount = ulLen - ulStart + 1;
pBaseArray = pArray->item.asArray.value;
for( ; ulCount > 0; ulCount --, ulStart ++ ) /* set value items */
for( ; ulCount > 0; ulCount--, ulStart++ ) /* set value items */
hb_itemCopy( pBaseArray->pItems + ( ulStart - 1 ), pValue );
}
else
@@ -355,7 +305,7 @@ void hb_arrayDel( PHB_ITEM pArray, ULONG ulIndex )
{
if( IS_ARRAY( pArray ) )
{
ULONG ulLen = hb_arrayLen( pArray );
ULONG ulLen = pArray->item.asArray.value->ulLen;
if( ulIndex > 0 && ulIndex <= ulLen )
{
@@ -363,7 +313,7 @@ void hb_arrayDel( PHB_ITEM pArray, ULONG ulIndex )
hb_itemClear( pBaseArray->pItems + ( ulIndex - 1 ) );
for( ulIndex --; ulIndex < ulLen; ulIndex ++ ) /* move items */
for( ulIndex--; ulIndex < ulLen; ulIndex++ ) /* move items */
hb_itemCopy( pBaseArray->pItems + ulIndex, pBaseArray->pItems + ( ulIndex + 1 ) );
hb_itemClear( pBaseArray->pItems + ( ulLen - 1 ) );
@@ -377,7 +327,7 @@ void hb_arrayIns( PHB_ITEM pArray, ULONG ulIndex )
{
if( IS_ARRAY( pArray ) )
{
ULONG ulLen = hb_arrayLen( pArray );
ULONG ulLen = pArray->item.asArray.value->ulLen;
if( ulIndex > 0 && ulIndex <= ulLen )
{
@@ -385,7 +335,7 @@ void hb_arrayIns( PHB_ITEM pArray, ULONG ulIndex )
hb_itemClear( pBaseArray->pItems + ( ulLen - 1 ) );
for( ulLen --; ulLen >= ulIndex; ulLen -- ) /* move items */
for( ulLen--; ulLen >= ulIndex; ulLen-- ) /* move items */
hb_itemCopy( pBaseArray->pItems + ulLen, pBaseArray->pItems + ( ulLen - 1 ) );
hb_itemClear( pBaseArray->pItems + ulLen );
@@ -399,9 +349,9 @@ int hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount
{
if( IS_ARRAY( pArray ) && pValue->type != IT_NIL )
{
PBASEARRAY pBaseArray = pArray->item.asArray.value;
ULONG ulLen = pBaseArray->ulLen;
BOOL bFound = FALSE;
PBASEARRAY pBaseArray;
ULONG ulLen = hb_arrayLen( pArray );
if( ulStart == 0 ) /* if parameter is missing */
ulStart = 1;
@@ -412,9 +362,7 @@ int hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount
if( ulStart + ulCount > ulLen ) /* check range */
ulCount = ulLen - ulStart + 1;
pBaseArray = pArray->item.asArray.value;
for( ulStart --; ulCount > 0; ulCount --, ulStart ++ )
for( ulStart--; ulCount > 0; ulCount--, ulStart++ )
{
PHB_ITEM pItem = pBaseArray->pItems + ulStart;
@@ -476,8 +424,8 @@ void hb_arrayEval( PHB_ITEM pArray, PHB_ITEM bBlock, ULONG ulStart, ULONG ulCoun
{
if( IS_ARRAY( pArray ) && IS_BLOCK( bBlock ) )
{
PBASEARRAY pBaseArray;
ULONG ulLen = hb_arrayLen( pArray );
PBASEARRAY pBaseArray = pArray->item.asArray.value;
ULONG ulLen = pBaseArray->ulLen;
if( ulStart == 0 ) /* if parameter is missing */
ulStart = 1;
@@ -488,9 +436,7 @@ void hb_arrayEval( PHB_ITEM pArray, PHB_ITEM bBlock, ULONG ulStart, ULONG ulCoun
if( ulStart + ulCount > ulLen ) /* check range */
ulCount = ulLen - ulStart + 1;
pBaseArray = pArray->item.asArray.value;
for( ulStart --; ulCount > 0; ulCount --, ulStart ++ )
for( ulStart--; ulCount > 0; ulCount--, ulStart++ )
{
PHB_ITEM pItem = pBaseArray->pItems + ulStart;
@@ -509,13 +455,14 @@ void hb_arrayRelease( PHB_ITEM pArray )
{
if( IS_ARRAY( pArray ) )
{
ULONG ul, ulLen = hb_arrayLen( pArray );
PBASEARRAY pBaseArray = pArray->item.asArray.value;
ULONG ulLen = pBaseArray->ulLen;
ULONG ulPos;
if( !pBaseArray->bSuperCast )
{
for( ul = 0; ul < ulLen; ul ++ )
hb_itemClear( pBaseArray->pItems + ul );
for( ulPos = 0; ulPos < ulLen; ulPos++ )
hb_itemClear( pBaseArray->pItems + ulPos );
if( pBaseArray->pItems )
hb_xfree( pBaseArray->pItems );
@@ -534,9 +481,10 @@ void hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG ulStart,
{
if( IS_ARRAY( pSrcArray ) && IS_ARRAY( pDstArray ) )
{
PBASEARRAY pSrcBaseArray, pDstBaseArray;
ULONG ulSrcLen = hb_arrayLen( pSrcArray );
ULONG ulDstLen = hb_arrayLen( pDstArray );
PBASEARRAY pSrcBaseArray = pSrcArray->item.asArray.value;
PBASEARRAY pDstBaseArray = pDstArray->item.asArray.value;
ULONG ulSrcLen = pSrcBaseArray->ulLen;
ULONG ulDstLen = pDstBaseArray->ulLen;
if( ulStart == 0 ) /* if parameter is missing */
ulStart = 1;
@@ -553,10 +501,7 @@ void hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG ulStart,
if( ulCount > ulDstLen )
ulCount = ulDstLen;
pSrcBaseArray = pSrcArray->item.asArray.value;
pDstBaseArray = pDstArray->item.asArray.value;
for( ulTarget --, ulStart --; ulCount > 0; ulCount --, ulStart ++ )
for( ulTarget--, ulStart--; ulCount > 0; ulCount--, ulStart++ )
hb_itemCopy( pDstBaseArray->pItems + ( ulTarget + ulStart ), pSrcBaseArray->pItems + ulStart );
}
else
@@ -569,16 +514,16 @@ PHB_ITEM hb_arrayClone( PHB_ITEM pSrcArray )
if( IS_ARRAY( pSrcArray ) )
{
PBASEARRAY pSrcBaseArray, pDstBaseArray;
ULONG ulCount, ulSrcLen = hb_arrayLen( pSrcArray );
PBASEARRAY pSrcBaseArray = pSrcArray->item.asArray.value;
PBASEARRAY pDstBaseArray = pDstArray->item.asArray.value;
ULONG ulSrcLen = pSrcBaseArray->ulLen;
ULONG ulCount;
hb_arrayNew( pDstArray, ulSrcLen );
pSrcBaseArray = pSrcArray->item.asArray.value;
pDstBaseArray = pDstArray->item.asArray.value;
pDstBaseArray->wClass = pSrcBaseArray->wClass;
for( ulCount = 0; ulCount < ulSrcLen; ulCount ++ )
for( ulCount = 0; ulCount < ulSrcLen; ulCount++ )
{
PHB_ITEM pSrcItem = pSrcBaseArray->pItems + ulCount;
@@ -643,7 +588,7 @@ HARBOUR HB_AADD( void )
hb_arrayAdd( pArray, pValue );
hb_itemCopy( &stack.Return, pValue );
hb_itemReturn( pValue );
}
else
hb_errRT_BASE( EG_ARG, 1123, NULL, "AADD" );
@@ -662,7 +607,7 @@ HARBOUR HB_ASIZE( void )
hb_arraySize( pArray, MAX( lSize, 0 ) );
hb_itemCopy( &stack.Return, pArray ); /* ASize() returns the array itself */
hb_itemReturn( pArray ); /* ASize() returns the array itself */
}
}
@@ -676,27 +621,27 @@ HARBOUR HB_ATAIL( void )
HARBOUR HB_AINS( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
{
if( ISNUM( 2 ) )
hb_arrayIns( pArray, hb_parnl( 2 ) );
hb_itemCopy( &stack.Return, pArray ); /* AIns() returns the array itself */
hb_itemReturn( pArray ); /* AIns() returns the array itself */
}
}
HARBOUR HB_ADEL( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
{
if( ISNUM( 2 ) )
hb_arrayDel( pArray, hb_parnl( 2 ) );
hb_itemCopy( &stack.Return, pArray ); /* ADel() returns the array itself */
hb_itemReturn( pArray ); /* ADel() returns the array itself */
}
}
@@ -704,12 +649,12 @@ HARBOUR HB_ADEL( void )
HARBOUR HB_AFILL( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
{
hb_arrayFill( pArray, hb_param( 2, IT_ANY ), hb_parnl( 3 ), hb_parnl( 4 ) );
hb_itemCopy( &stack.Return, pArray ); /* AFill() returns the array itself */
hb_itemReturn( pArray ); /* AFill() returns the array itself */
}
}
@@ -735,7 +680,7 @@ HARBOUR HB_AEVAL( void )
if( pArray && pBlock )
{
hb_arrayEval( pArray, pBlock, hb_parnl( 3 ), hb_parnl( 4 ) );
hb_itemCopy( &stack.Return, pArray ); /* AEval() returns the array itself */
hb_itemReturn( pArray ); /* AEval() returns the array itself */
}
else
hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL" );
@@ -745,26 +690,25 @@ HARBOUR HB_AEVAL( void )
HARBOUR HB_ACOPY( void )
{
PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY );
PHB_ITEM pDstArray = hb_param( 2, IT_ARRAY );
PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY );
PHB_ITEM pDstArray = hb_param( 2, IT_ARRAY );
if( pSrcArray && pDstArray )
{
hb_arrayCopy( pSrcArray, pDstArray, hb_parnl( 3 ), hb_parnl( 4 ), hb_parnl( 5 ) );
hb_itemCopy( &stack.Return, pDstArray ); /* ACopy() returns the target array */
hb_itemReturn( pDstArray ); /* ACopy() returns the target array */
}
}
HARBOUR HB_ACLONE( void )
{
PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY );
PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY );
if( pSrcArray )
{
PHB_ITEM pDstArray = hb_arrayClone( pSrcArray );
hb_itemCopy( &stack.Return, pDstArray ); /* AClone() returns the new array */
hb_itemClear( pDstArray );
hb_xfree( pDstArray );
hb_itemReturn( pDstArray ); /* AClone() returns the new array */
hb_itemRelease( pDstArray );
}
}

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

@@ -107,8 +107,8 @@ void hb_consoleInitialize( void )
/* Some compilers open stdout and stderr in text mode, but
Harbour needs them to be open in binary mode. */
hb_fsSetMode( fileno( stdout ), FM_BINARY );
hb_fsSetMode( fileno( stderr ), FM_BINARY );
hb_fsSetDevMode( fileno( stdout ), FM_BINARY );
hb_fsSetDevMode( fileno( stderr ), FM_BINARY );
#ifdef HARBOUR_USE_GTAPI
hb_gtInit();
@@ -327,7 +327,7 @@ static void hb_altout( char * pStr, ULONG len )
write_len = count;
count = 0;
}
hb_fsWrite( hb_set_althan, (BYTE *)pPtr, write_len );
hb_fsWrite( hb_set_althan, ( BYTE * ) pPtr, write_len );
pPtr += write_len;
}
}
@@ -349,7 +349,7 @@ static void hb_altout( char * pStr, ULONG len )
write_len = count;
count = 0;
}
hb_fsWrite( hb_set_extrahan, (BYTE *)pPtr, write_len );
hb_fsWrite( hb_set_extrahan, ( BYTE * ) pPtr, write_len );
pPtr += write_len;
}
}
@@ -371,7 +371,7 @@ static void hb_altout( char * pStr, ULONG len )
write_len = count;
count = 0;
}
hb_fsWrite( hb_set_printhan, (BYTE *)pPtr, write_len );
hb_fsWrite( hb_set_printhan, ( BYTE * ) pPtr, write_len );
pPtr += write_len;
}
if( len + s_uiPCol > USHRT_MAX ) s_uiPCol = USHRT_MAX;
@@ -400,7 +400,7 @@ static void hb_devout( char * pStr, ULONG len )
write_len = count;
count = 0;
}
hb_fsWrite( hb_set_printhan, (BYTE *)pPtr, write_len );
hb_fsWrite( hb_set_printhan, ( BYTE * ) pPtr, write_len );
pPtr += write_len;
}
if( len + s_uiPCol > USHRT_MAX ) s_uiPCol = USHRT_MAX;
@@ -473,18 +473,18 @@ void hb_devpos( WORD row, WORD col )
{
if( row < s_uiPRow )
{
hb_fsWrite( hb_set_printhan, (BYTE *)"\x0C", 1 );
hb_fsWrite( hb_set_printhan, ( BYTE * ) "\x0C", 1 );
s_uiPRow = s_uiPCol = 0;
}
for( count = s_uiPRow; count < row; count++ )
hb_fsWrite( hb_set_printhan, (BYTE *)s_szCrLf, CRLF_BUFFER_LEN-1 );
hb_fsWrite( hb_set_printhan, ( BYTE * ) s_szCrLf, CRLF_BUFFER_LEN-1 );
if( row > s_uiPRow ) s_uiPCol = 0;
col += hb_set.HB_SET_MARGIN;
for( count = s_uiPCol; count < col; count++ )
hb_fsWrite( hb_set_printhan, (BYTE *)" ", 1 );
hb_fsWrite( hb_set_printhan, ( BYTE * ) " ", 1 );
s_uiPRow = row;
s_uiPCol = col;
@@ -540,7 +540,7 @@ HARBOUR HB_QOUT( void )
s_uiPCol = hb_set.HB_SET_MARGIN;
count = s_uiPCol;
while( count-- > 0 )
hb_fsWrite( hb_set_printhan, (BYTE *)" ", 1 );
hb_fsWrite( hb_set_printhan, ( BYTE * ) " ", 1 );
}
HB_QQOUT();
@@ -618,9 +618,7 @@ HARBOUR HB_DEVOUT( void ) /* writes a single value to the current device (screen
#ifdef HARBOUR_USE_GTAPI
if( ISCHAR( 2 ) )
{
hb_gtSetColorStr( pOldColor );
}
#endif
}
}
@@ -643,9 +641,7 @@ HARBOUR HB_DISPOUT( void ) /* writes a single value to the current device (scree
#ifdef HARBOUR_USE_GTAPI
if( ISCHAR( 2 ) )
{
hb_gtSetColorStr( pOldColor );
}
#endif
}
}
@@ -654,7 +650,7 @@ HARBOUR HB___EJECT( void ) /* Ejects the current page from the printer */
{
if( hb_stricmp( hb_set.HB_SET_DEVICE, "PRINTER" ) == 0 && hb_set_printhan >= 0 )
{
hb_fsWrite( hb_set_printhan, (BYTE *)"\x0C\x0D", 2 );
hb_fsWrite( hb_set_printhan, ( BYTE * ) "\x0C\x0D", 2 );
s_uiPRow = s_uiPCol = 0;
}
}
@@ -787,22 +783,14 @@ HARBOUR HB_DISPBOX( void )
}
if( ISCHAR( 5 ) )
{
hb_gtBox( hb_parni( 1 ), hb_parni( 2 ), hb_parni( 3 ), hb_parni( 4 ), hb_parc( 5 ));
}
else if( ISNUM( 5 ) && hb_parni( 5 ) == 2 )
{
hb_gtBoxD( hb_parni( 1 ), hb_parni( 2 ), hb_parni( 3 ), hb_parni( 4 ) );
}
else
{
hb_gtBoxS( hb_parni( 1 ), hb_parni( 2 ), hb_parni( 3 ), hb_parni( 4 ) );
}
if( ISCHAR( 6 ) )
{
hb_gtSetColorStr( szOldColor );
}
}
#else
if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) && ISNUM( 4 ) )
@@ -1079,10 +1067,7 @@ HARBOUR HB___ACCEPT( void ) /* Internal Clipper function used in ACCEPT command
Unix compatible operating systems yet. */
szResult[ 0 ] = '\0'; /* start with something defined */
if( fgets( szResult, ACCEPT_BUFFER_LEN, stdin ) )
{
strtok( szResult, "\n" ); /* strip off the trailing newline
if it exists */
}
strtok( szResult, "\n" ); /* strip off the trailing newline if it exists */
#else
len = 0;
input = 0;

23
harbour/source/rtl/dates.c
View File

@@ -53,8 +53,6 @@
#define HB_OPTIMIZE_DTOS
#endif
/* The other functions are pulled in automatically by initsymb.c */
double hb_secondsToday( void )
{
#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__DJGPP__) /* || defined(_MSC_VER) */
@@ -151,16 +149,21 @@ void hb_dateDecode( long julian, long * plDay, long * plMonth, long * plYear )
void hb_dateStrPut( char * szDate, long lDay, long lMonth, long lYear )
{
szDate[ 0 ] = ( lYear / 1000 ) + '0';
szDate[ 1 ] = ( ( lYear % 1000 ) / 100 ) + '0';
szDate[ 2 ] = ( ( lYear % 100 ) / 10 ) + '0';
szDate[ 3 ] = ( lYear % 10 ) + '0';
if( lDay && lMonth && lYear )
{
szDate[ 0 ] = ( lYear / 1000 ) + '0';
szDate[ 1 ] = ( ( lYear % 1000 ) / 100 ) + '0';
szDate[ 2 ] = ( ( lYear % 100 ) / 10 ) + '0';
szDate[ 3 ] = ( lYear % 10 ) + '0';
szDate[ 4 ] = ( lMonth / 10 ) + '0';
szDate[ 5 ] = ( lMonth % 10 ) + '0';
szDate[ 4 ] = ( lMonth / 10 ) + '0';
szDate[ 5 ] = ( lMonth % 10 ) + '0';
szDate[ 6 ] = ( lDay / 10 ) + '0';
szDate[ 7 ] = ( lDay % 10 ) + '0';
szDate[ 6 ] = ( lDay / 10 ) + '0';
szDate[ 7 ] = ( lDay % 10 ) + '0';
}
else
memset( szDate, ' ', 8 );
}
void hb_dateStrGet( const char * szDate, long * plDay, long * plMonth, long * plYear )

4
harbour/source/rtl/descend.c
View File

@@ -106,10 +106,6 @@ HARBOUR HB_DESCEND( void )
pReturn = hb_itemPutND( NULL, -1 * dValue );
hb_itemReturn( pReturn );
hb_itemRelease( pReturn );
/* It is dangerous to operate on the stack directly
stack.Return.wDec = pItem->wDec;
*/
}
else if( IS_LOGICAL( pItem ) )
hb_retl( ! pItem->item.asLogical.value );

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

@@ -479,8 +479,7 @@ HARBOUR HB_DIRECTORY( void )
closedir( dir );
#endif
hb_itemCopy( &stack.Return, pdir ); /* DIRECTORY() returns an array */
hb_itemReturn( pdir ); /* DIRECTORY() returns an array */
hb_itemRelease( pdir );
#if defined(_MSC_VER) || defined(__IBMCPP__)

14
harbour/source/rtl/errorapi.c
View File

@@ -25,6 +25,7 @@
/* Harbour Project source code
http://www.Harbour-Project.org/
The following functions are Copyright 1999 Victor Szel <info@szelvesz.hu>:
HB_DOSERROR()
hb_errLaunch()
hb_errLaunchSubst()
hb_errGetFlags()
@@ -51,8 +52,9 @@
better shows what is really the problem */
#define HB_ERROR_LAUNCH_MAX 8
static int s_iLaunchCount = 0;
static HB_ITEM s_errorBlock;
static int s_iLaunchCount = 0;
static USHORT s_uiErrorDOS = 0; /* The value of DOSERROR() */
extern HARBOUR HB_ERRORNEW( void );
@@ -78,6 +80,16 @@ HARBOUR HB_ERRORBLOCK( void )
hb_itemClear( &oldError );
}
/* TOFIX: Make it Clipper compatible */
HARBOUR HB_DOSERROR( void )
{
hb_retni( s_uiErrorDOS );
if( ISNUM( 1 ) )
s_uiErrorDOS = ( USHORT ) hb_parni( 1 );
}
void hb_errInit( void )
{
hb_itemClear( &s_errorBlock );

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

@@ -136,7 +136,7 @@ ULONG hb_parclen( int iParam, ... )
return 0;
}
/* Same as _parclen() but return the length including the */
/* Same as _parclen() but returns the length including the */
/* terminating zero byte */
ULONG hb_parcsiz( int iParam, ... )
@@ -189,16 +189,13 @@ char * hb_pards( int iParam, ... )
if( IS_DATE( pItem ) )
{
if( pItem->item.asDate.value > 0 )
{
long lDay, lMonth, lYear;
long lDay, lMonth, lYear;
hb_dateDecode( pItem->item.asDate.value, &lDay, &lMonth, &lYear );
hb_dateStrPut( stack.szDate, lDay, lMonth, lYear );
stack.szDate[ 8 ] = '\0';
hb_dateDecode( pItem->item.asDate.value, &lDay, &lMonth, &lYear );
hb_dateStrPut( stack.szDate, lDay, lMonth, lYear );
stack.szDate[ 8 ] = '\0';
return stack.szDate; /* this guaranties good behavior when multithreading */
}
return stack.szDate; /* this guaranties good behavior when multithreading */
}
else if( IS_ARRAY( pItem ) )
{

14
harbour/source/rtl/filesys.c
View File

@@ -5,7 +5,8 @@
/* Harbour Project source code
http://www.Harbour-Project.org/
The following functions are Copyright 1999 Victor Szel <info@szelvesz.hu>:
hb_fsSetMode()
hb_fsSetError()
hb_fsSetDevMode()
hb_fsReadLarge()
hb_fsWriteLarge()
HB_CURDIR()
@@ -349,13 +350,13 @@ void hb_fsClose( FHANDLE hFileHandle )
}
void hb_fsSetMode( FHANDLE hFileHandle, USHORT uiMode )
void hb_fsSetDevMode( FHANDLE hFileHandle, USHORT uiDevMode )
{
#if defined(__BORLANDC__) || defined(__IBMCPP__) || defined(__DJGPP__) || defined(__CYGWIN__)
errno = 0;
switch( uiMode )
switch( uiDevMode )
{
case FM_BINARY:
setmode( hFileHandle, O_BINARY );
@@ -370,7 +371,7 @@ void hb_fsSetMode( FHANDLE hFileHandle, USHORT uiMode )
#elif defined(_MSC_VER)
errno = 0;
switch( uiMode )
switch( uiDevMode )
{
case FM_BINARY:
_setmode( hFileHandle, _O_BINARY );
@@ -545,6 +546,11 @@ USHORT hb_fsError( void )
return s_uiErrorLast;
}
void hb_fsSetError( USHORT uiError )
{
s_uiErrorLast = uiError;
}
int hb_fsDelete ( BYTE * pFilename )
{
int retval;

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

@@ -25,6 +25,7 @@
/* Harbour Project source code
http://www.Harbour-Project.org/
The following functions are Copyright 1999 Victor Szel <info@szelvesz.hu>:
hb_itemGetCLen()
hb_itemGetNLen()
hb_itemSetNLen()
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
@@ -233,6 +234,14 @@ char * hb_itemGetC( PHB_ITEM pItem )
return NULL;
}
ULONG hb_itemGetCLen( PHB_ITEM pItem )
{
if( pItem && IS_STRING( pItem ) )
return pItem->item.asString.length;
else
return 0;
}
ULONG hb_itemCopyC( PHB_ITEM pItem, char * szBuffer, ULONG ulLen )
{
if( pItem && IS_STRING( pItem ) )

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

@@ -863,19 +863,16 @@ static void hb_vmDebuggerShowLine( WORD wLine ) /* makes the debugger shows a sp
void hb_vmDec( void )
{
double dNumber;
LONG lDate;
WORD wDec;
if( IS_NUMERIC( stack.pPos - 1 ) )
{
dNumber = hb_vmPopDouble( &wDec );
WORD wDec;
double dNumber = hb_vmPopDouble( &wDec );
hb_vmPushNumber( --dNumber, wDec );
}
else if( IS_DATE( stack.pPos - 1 ) )
{
lDate = hb_vmPopDate();
hb_vmPushDate( --lDate ); /* TOFIX: Dates should decreased other way */
LONG lDate = hb_vmPopDate();
hb_vmPushDate( --lDate ); /* TOFIX: Dates should be decreased other way */
}
else
hb_errRT_BASE( EG_ARG, 1087, NULL, "--" );
@@ -1095,8 +1092,6 @@ void hb_vmEqual( BOOL bExact )
{
PHB_ITEM pItem2 = stack.pPos - 1;
PHB_ITEM pItem1 = stack.pPos - 2;
int i;
WORD wDec;
if( IS_NIL( pItem1 ) && IS_NIL( pItem2 ) )
{
@@ -1114,18 +1109,24 @@ void hb_vmEqual( BOOL bExact )
else if( IS_STRING( pItem1 ) && IS_STRING( pItem2 ) )
{
i = hb_itemStrCmp( pItem1, pItem2, bExact );
int i = hb_itemStrCmp( pItem1, pItem2, bExact );
hb_stackPop();
hb_stackPop();
hb_vmPushLogical( i == 0 );
}
else if( IS_NUMERIC( pItem1 ) && IS_NUMERIC( pItem2 ) )
{
WORD wDec;
hb_vmPushLogical( hb_vmPopDouble( &wDec ) == hb_vmPopDouble( &wDec ) );
}
else if( IS_DATE( pItem1 ) && IS_DATE( pItem2 ) )
hb_vmPushLogical( hb_vmPopDate() == hb_vmPopDate() );
else if( IS_LOGICAL( pItem1 ) && IS_LOGICAL( pItem2 ) )
hb_vmPushLogical( hb_vmPopLogical() == hb_vmPopLogical() );
else if( IS_NUMERIC( pItem1 ) && IS_NUMERIC( pItem2 ) )
hb_vmPushLogical( hb_vmPopDouble( &wDec ) == hb_vmPopDouble( &wDec ) );
else if( IS_OBJECT( pItem1 ) && hb_objHasMsg( pItem1, "==" ) )
hb_vmOperatorCall( pItem1, pItem2, "==" );
@@ -1218,13 +1219,9 @@ void hb_vmGenArray( WORD wElements ) /* generates a wElements Array and fills it
void hb_vmGreater( void )
{
double dNumber1, dNumber2;
LONG lDate1, lDate2;
int i;
if( IS_STRING( stack.pPos - 2 ) && IS_STRING( stack.pPos - 1 ) )
{
i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE );
int i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE );
hb_stackPop();
hb_stackPop();
hb_vmPushLogical( i > 0 );
@@ -1232,15 +1229,15 @@ void hb_vmGreater( void )
else if( IS_NUMERIC( stack.pPos - 1 ) && IS_NUMERIC( stack.pPos - 2 ) )
{
dNumber2 = hb_vmPopNumber();
dNumber1 = hb_vmPopNumber();
double dNumber2 = hb_vmPopNumber();
double dNumber1 = hb_vmPopNumber();
hb_vmPushLogical( dNumber1 > dNumber2 );
}
else if( IS_DATE( stack.pPos - 1 ) && IS_DATE( stack.pPos - 2 ) )
{
lDate2 = hb_vmPopDate();
lDate1 = hb_vmPopDate();
LONG lDate2 = hb_vmPopDate();
LONG lDate1 = hb_vmPopDate();
hb_vmPushLogical( lDate1 > lDate2 );
}
@@ -1261,13 +1258,9 @@ void hb_vmGreater( void )
void hb_vmGreaterEqual( void )
{
double dNumber1, dNumber2;
LONG lDate1, lDate2;
int i;
if( IS_STRING( stack.pPos - 2 ) && IS_STRING( stack.pPos - 1 ) )
{
i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE );
int i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE );
hb_stackPop();
hb_stackPop();
hb_vmPushLogical( i >= 0 );
@@ -1275,15 +1268,15 @@ void hb_vmGreaterEqual( void )
else if( IS_NUMERIC( stack.pPos - 1 ) && IS_NUMERIC( stack.pPos - 2 ) )
{
dNumber2 = hb_vmPopNumber();
dNumber1 = hb_vmPopNumber();
double dNumber2 = hb_vmPopNumber();
double dNumber1 = hb_vmPopNumber();
hb_vmPushLogical( dNumber1 >= dNumber2 );
}
else if( IS_DATE( stack.pPos - 1 ) && IS_DATE( stack.pPos - 2 ) )
{
lDate2 = hb_vmPopDate();
lDate1 = hb_vmPopDate();
LONG lDate2 = hb_vmPopDate();
LONG lDate1 = hb_vmPopDate();
hb_vmPushLogical( lDate1 >= lDate2 );
}
@@ -1304,18 +1297,15 @@ void hb_vmGreaterEqual( void )
void hb_vmInc( void )
{
double dNumber;
LONG lDate;
WORD wDec;
if( IS_NUMERIC( stack.pPos - 1 ) )
{
dNumber = hb_vmPopDouble( &wDec );
WORD wDec;
double dNumber = hb_vmPopDouble( &wDec );
hb_vmPushNumber( ++dNumber, wDec );
}
else if( IS_DATE( stack.pPos - 1 ) )
{
lDate = hb_vmPopDate();
LONG lDate = hb_vmPopDate();
hb_vmPushDate( ++lDate );
}
else
@@ -1341,13 +1331,9 @@ void hb_vmInstring( void )
void hb_vmLess( void )
{
double dNumber1, dNumber2;
LONG lDate1, lDate2;
int i;
if( IS_STRING( stack.pPos - 2 ) && IS_STRING( stack.pPos - 1 ) )
{
i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE );
int i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE );
hb_stackPop();
hb_stackPop();
hb_vmPushLogical( i < 0 );
@@ -1355,15 +1341,15 @@ void hb_vmLess( void )
else if( IS_NUMERIC( stack.pPos - 1 ) && IS_NUMERIC( stack.pPos - 2 ) )
{
dNumber2 = hb_vmPopNumber();
dNumber1 = hb_vmPopNumber();
double dNumber2 = hb_vmPopNumber();
double dNumber1 = hb_vmPopNumber();
hb_vmPushLogical( dNumber1 < dNumber2 );
}
else if( IS_DATE( stack.pPos - 1 ) && IS_DATE( stack.pPos - 2 ) )
{
lDate2 = hb_vmPopDate();
lDate1 = hb_vmPopDate();
LONG lDate2 = hb_vmPopDate();
LONG lDate1 = hb_vmPopDate();
hb_vmPushLogical( lDate1 < lDate2 );
}
@@ -1384,13 +1370,9 @@ void hb_vmLess( void )
void hb_vmLessEqual( void )
{
double dNumber1, dNumber2;
LONG lDate1, lDate2;
int i;
if( IS_STRING( stack.pPos - 2 ) && IS_STRING( stack.pPos - 1 ) )
{
i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE );
int i = hb_itemStrCmp( stack.pPos - 2, stack.pPos - 1, FALSE );
hb_stackPop();
hb_stackPop();
hb_vmPushLogical( i <= 0 );
@@ -1398,15 +1380,15 @@ void hb_vmLessEqual( void )
else if( IS_NUMERIC( stack.pPos - 1 ) && IS_NUMERIC( stack.pPos - 2 ) )
{
dNumber2 = hb_vmPopNumber();
dNumber1 = hb_vmPopNumber();
double dNumber2 = hb_vmPopNumber();
double dNumber1 = hb_vmPopNumber();
hb_vmPushLogical( dNumber1 <= dNumber2 );
}
else if( IS_DATE( stack.pPos - 1 ) && IS_DATE( stack.pPos - 2 ) )
{
lDate2 = hb_vmPopDate();
lDate1 = hb_vmPopDate();
LONG lDate2 = hb_vmPopDate();
LONG lDate1 = hb_vmPopDate();
hb_vmPushLogical( lDate1 <= lDate2 );
}
@@ -1471,8 +1453,6 @@ void hb_vmNotEqual( void )
{
PHB_ITEM pItem2 = stack.pPos - 1;
PHB_ITEM pItem1 = stack.pPos - 2;
int i;
WORD wDec;
if( IS_NIL( pItem1 ) && IS_NIL( pItem2 ) )
{
@@ -1490,14 +1470,20 @@ void hb_vmNotEqual( void )
else if( IS_STRING( pItem1 ) && IS_STRING( pItem2 ) )
{
i = hb_itemStrCmp( pItem1, pItem2, FALSE );
int i = hb_itemStrCmp( pItem1, pItem2, FALSE );
hb_stackPop();
hb_stackPop();
hb_vmPushLogical( i != 0 );
}
else if( IS_NUMERIC( pItem1 ) && IS_NUMERIC( pItem2 ) )
{
WORD wDec;
hb_vmPushLogical( hb_vmPopDouble( &wDec ) != hb_vmPopDouble( &wDec ) );
}
else if( IS_DATE( pItem1 ) && IS_DATE( pItem2 ) )
hb_vmPushLogical( hb_vmPopDate() != hb_vmPopDate() );
else if( IS_LOGICAL( pItem1 ) && IS_LOGICAL( pItem2 ) )
hb_vmPushLogical( hb_vmPopLogical() != hb_vmPopLogical() );

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

@@ -226,6 +226,45 @@ FUNCTION Main( cPar1 )
TEST_LINE( ValType( @mbBlock ) , "U" )
TEST_LINE( ValType( @maArray ) , "U" )
/* STOD() */
/* For these tests in CA-Cl*pper 5.2e the following native STOD() has
been used ( not the emulated one written in Clipper ):
CLIPPER STOD( void )
{
// The length check is a fix to avoid buggy behaviour of _retds()
_retds( ( ISCHAR( 1 ) && _parclen( 1 ) == 8 ) ? _parc( 1 ) : " " );
}
*/
TEST_LINE( SToD() , SToD(" ") )
TEST_LINE( SToD(1) , SToD(" ") )
TEST_LINE( SToD(NIL) , SToD(" ") )
TEST_LINE( SToD("") , SToD(" ") )
TEST_LINE( SToD(" ") , SToD(" ") )
TEST_LINE( SToD(" ") , SToD(" ") )
TEST_LINE( SToD(" ") , SToD(" ") )
TEST_LINE( SToD(" 1234567") , SToD(" ") )
TEST_LINE( SToD("1999 ") , SToD(" ") )
TEST_LINE( SToD("99999999") , SToD(" ") )
TEST_LINE( SToD("99990101") , SToD(" ") )
TEST_LINE( SToD("19991301") , SToD(" ") )
TEST_LINE( SToD("19991241") , SToD(" ") )
TEST_LINE( SToD("01000101") , SToD("01000101") )
TEST_LINE( SToD("29991231") , SToD("29991231") )
TEST_LINE( SToD("19990905") , SToD("19990905") )
TEST_LINE( SToD(" 9990905") , SToD(" ") )
TEST_LINE( SToD("1 990905") , SToD(" ") )
TEST_LINE( SToD("19 90905") , SToD("17490905") )
TEST_LINE( SToD("199 0905") , SToD("19740905") )
TEST_LINE( SToD("1999 905") , SToD(" ") )
TEST_LINE( SToD("19990 05") , SToD(" ") )
TEST_LINE( SToD("199909 5") , SToD(" ") )
TEST_LINE( SToD("1999090 ") , SToD(" ") )
TEST_LINE( SToD("1999 9 5") , SToD(" ") )
TEST_LINE( SToD("1999090" + Chr(0)) , SToD(" ") )
/* DESCEND() */
TEST_LINE( Descend() , NIL ) /* Bug in CA-Cl*pper, it returns undefined trash */
@@ -258,42 +297,6 @@ FUNCTION Main( cPar1 )
TEST_LINE( Descend( SToD( "01000101" ) ) , 3474223 )
TEST_LINE( Descend( SToD( "19801220" ) ) , 2787214 )
/* Decimals handling */
TEST_LINE( Str(Max(10, 12) ) , " 12" )
TEST_LINE( Str(Max(10.50, 10) ) , " 10.50" )
TEST_LINE( Str(Max(10, 9.50) ) , " 10" )
TEST_LINE( Str(Max(100000, 10) ) , " 100000" )
TEST_LINE( Str(Max(20.50, 20.670) ) , " 20.670" )
TEST_LINE( Str(Max(20.5125, 20.670) ) , " 20.670" )
TEST_LINE( Str(Min(10, 12) ) , " 10" )
TEST_LINE( Str(Min(10.50, 10) ) , " 10" )
TEST_LINE( Str(Min(10, 9.50) ) , " 9.50" )
TEST_LINE( Str(Min(100000, 10) ) , " 10" )
TEST_LINE( Str(Min(20.50, 20.670) ) , " 20.50" )
TEST_LINE( Str(Min(20.5125, 20.670) ) , " 20.5125" )
TEST_LINE( Str(Val("1") ) , "1" )
TEST_LINE( Str(Val("15") ) , "15" )
TEST_LINE( Str(Val("200") ) , "200" )
TEST_LINE( Str(Val("15.0") ) , "15.0" )
TEST_LINE( Str(Val("15.00") ) , "15.00" )
TEST_LINE( Str(Year(SToD("19990905")) ) , " 1999" )
TEST_LINE( Str(Month(SToD("19990905")) ) , " 9" )
TEST_LINE( Str(Day(SToD("19990905")) ) , " 5" )
TEST_LINE( Str(10 ) , " 10" )
TEST_LINE( Str(15.0 ) , " 15.0" )
TEST_LINE( Str(10.1 ) , " 10.1" )
TEST_LINE( Str(15.00 ) , " 15.00" )
TEST_LINE( Str(Log(0) ) , "***********************" )
TEST_LINE( Str(100.2 * 200.12 ) , " 20052.024" )
TEST_LINE( Str(100.20 * 200.12 ) , " 20052.0240" )
TEST_LINE( Str(1000.2 * 200.12 ) , " 200160.024" )
TEST_LINE( Str(100/1000 ) , " 0.10" )
TEST_LINE( Str(100/100000 ) , " 0.00" )
TEST_LINE( Str(10 * 10 ) , " 100" )
TEST_LINE( Str(100 / 10 ) , " 10" )
TEST_LINE( Str(1234567890 * 1234567890 ) , " 1524157875019052000" )
/* (operators) */
TEST_LINE( 1 + NIL , "E BASE 1081 Argument error + F:S" )
@@ -829,6 +832,42 @@ FUNCTION Main( cPar1 )
TEST_LINE( Str(-100000, 6, -1) , "******" )
TEST_LINE( Str(-100000, 8, -1) , " -100000" )
/* Decimals handling */
TEST_LINE( Str(Max(10, 12) ) , " 12" )
TEST_LINE( Str(Max(10.50, 10) ) , " 10.50" )
TEST_LINE( Str(Max(10, 9.50) ) , " 10" )
TEST_LINE( Str(Max(100000, 10) ) , " 100000" )
TEST_LINE( Str(Max(20.50, 20.670) ) , " 20.670" )
TEST_LINE( Str(Max(20.5125, 20.670) ) , " 20.670" )
TEST_LINE( Str(Min(10, 12) ) , " 10" )
TEST_LINE( Str(Min(10.50, 10) ) , " 10" )
TEST_LINE( Str(Min(10, 9.50) ) , " 9.50" )
TEST_LINE( Str(Min(100000, 10) ) , " 10" )
TEST_LINE( Str(Min(20.50, 20.670) ) , " 20.50" )
TEST_LINE( Str(Min(20.5125, 20.670) ) , " 20.5125" )
TEST_LINE( Str(Val("1") ) , "1" )
TEST_LINE( Str(Val("15") ) , "15" )
TEST_LINE( Str(Val("200") ) , "200" )
TEST_LINE( Str(Val("15.0") ) , "15.0" )
TEST_LINE( Str(Val("15.00") ) , "15.00" )
TEST_LINE( Str(Year(SToD("19990905")) ) , " 1999" )
TEST_LINE( Str(Month(SToD("19990905")) ) , " 9" )
TEST_LINE( Str(Day(SToD("19990905")) ) , " 5" )
TEST_LINE( Str(10 ) , " 10" )
TEST_LINE( Str(15.0 ) , " 15.0" )
TEST_LINE( Str(10.1 ) , " 10.1" )
TEST_LINE( Str(15.00 ) , " 15.00" )
TEST_LINE( Str(Log(0) ) , "***********************" )
TEST_LINE( Str(100.2 * 200.12 ) , " 20052.024" )
TEST_LINE( Str(100.20 * 200.12 ) , " 20052.0240" )
TEST_LINE( Str(1000.2 * 200.12 ) , " 200160.024" )
TEST_LINE( Str(100/1000 ) , " 0.10" )
TEST_LINE( Str(100/100000 ) , " 0.00" )
TEST_LINE( Str(10 * 10 ) , " 100" )
TEST_LINE( Str(100 / 10 ) , " 10" )
TEST_LINE( Str(1234567890 * 1234567890 ) , " 1524157875019052000" )
/* STRZERO() */
TEST_LINE( StrZero(10) , "0000000010" )
@@ -1232,13 +1271,20 @@ STATIC FUNCTION ErrorMessage( oError )
#ifndef __XPP__
STATIC FUNCTION SToD( cDate )
LOCAL cOldDateFormat := Set( _SET_DATEFORMAT, "yyyy/mm/dd" )
LOCAL cOldDateFormat
LOCAL dDate
LOCAL dDate := CToD( SubStr( cDate, 1, 4 ) + "/" +;
SubStr( cDate, 5, 2 ) + "/" +;
SubStr( cDate, 7, 2 ) )
IF ValType( cDate ) == "C"
cOldDateFormat := Set( _SET_DATEFORMAT, "yyyy/mm/dd" )
Set( _SET_DATEFORMAT, cOldDateFormat )
dDate := CToD( SubStr( cDate, 1, 4 ) + "/" +;
SubStr( cDate, 5, 2 ) + "/" +;
SubStr( cDate, 7, 2 ) )
Set( _SET_DATEFORMAT, cOldDateFormat )
ELSE
dDate := CToD( "" )
ENDIF
RETURN dDate