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

19990905-17:48 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-09-05 16:02:04 +00:00
parent 62a76f1c80
commit 048cd311ae
10 changed files with 328 additions and 144 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
harbour/ChangeLog
View File

@@ -1,3 +1,39 @@
19990905-17:48 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/dbf1.c
% Uses hb_itemPutN?Len() instead of hb_itemSetNLen(), so it's a bit
faster now.
* source/rtl/errorapi.c
% Now uses hb_itemDo() instead of the Eval API. Eight function calls
substituted with a single one.
* source/rtl/extend.c
+ hb_retn?len() functions now make simple calls to hb_itemPutN?Len()
functions.
* source/rtl/itemapi.c
include/itemapi.h
+ EVALINFO structure now has a Clipper compatible paramCount member.
! hb_eval*() speed up a bit by using paramCount, and by assigning error
return value only on error.
! hb_evalPutParam() now check if pItem is a NULL.
! hb_evalRelease() now sets back the EVALINFO structure to an initial
state, just like Clipper.
+ hb_itemDo() and hb_itemDoC() function added, they do the same as hb_eval()
but in a lot more convenient way.
+ hb_itemPutNDLen(), hb_itemPutNILen(), hb_itemPutNLLen() functions added
to make to number lenght setting easier.
* source/rtl/do.c
! DO() without any parameter caused a GPF. Fixed.
* tests/working/rtl_test.prg
+ Alias tests enabled. Now an internal occurs in one of them, this will
need fixing. Some alias Pop/Push/Swap functions are not checking NULL
pointers and are not yet compatible with Clipper in strange situations.
+ Fixed some result in == test with objects and arrays. Added some more
== tests.
* source/vm/hvm.c
! Small correction in one debug message.
* source/vm/initsymb.c
+ SETPOSBS added to the list. Since it's a native opcode in Clipper, it
always linked in by nature.
19990905-02:47 EDT Paul Tucker <ptucker@sympatico.ca>
* source/rtl/filesys.c
* casts on access() and in HB_FILE

7
harbour/include/itemapi.h
View File

@@ -33,6 +33,7 @@
typedef struct
{
USHORT paramCount;
PHB_ITEM pItems[ HB_EVAL_PARAM_MAX_ + 1 ];
} EVALINFO, * PEVALINFO, * EVALINFO_PTR;
@@ -41,6 +42,9 @@ extern BOOL hb_evalNew ( PEVALINFO pEvalInfo, PHB_ITEM pItem );
extern BOOL hb_evalPutParam ( PEVALINFO pEvalInfo, PHB_ITEM pItem );
extern BOOL hb_evalRelease ( PEVALINFO pEvalInfo );
extern PHB_ITEM hb_itemDo ( PHB_ITEM pItem, USHORT uiPCount, ... );
extern PHB_ITEM hb_itemDoC ( char * szFunc, USHORT uiPCount, ... );
extern PHB_ITEM hb_itemArrayGet ( PHB_ITEM pArray, ULONG ulIndex );
extern PHB_ITEM hb_itemArrayNew ( ULONG ulLen );
extern PHB_ITEM hb_itemArrayPut ( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem );
@@ -65,6 +69,9 @@ extern PHB_ITEM hb_itemPutL ( PHB_ITEM pItem, BOOL bValue );
extern PHB_ITEM hb_itemPutND ( PHB_ITEM pItem, double dNumber );
extern PHB_ITEM hb_itemPutNI ( PHB_ITEM pItem, int iNumber );
extern PHB_ITEM hb_itemPutNL ( PHB_ITEM pItem, long lNumber );
extern PHB_ITEM hb_itemPutNDLen ( PHB_ITEM pItem, double dNumber, WORD wWidth, WORD wDecimal );
extern PHB_ITEM hb_itemPutNILen ( PHB_ITEM pItem, int iNumber, WORD wWidth );
extern PHB_ITEM hb_itemPutNLLen ( PHB_ITEM pItem, long lNumber, WORD wWidth );
extern BOOL hb_itemRelease ( PHB_ITEM pItem );
extern PHB_ITEM hb_itemReturn ( PHB_ITEM pItem );
extern ULONG hb_itemSize ( PHB_ITEM pItem );

25
harbour/source/rdd/dbf1.c
View File

@@ -117,7 +117,7 @@ static BOOL hb_nltoa( LONG lValue, char * szBuffer, USHORT uiLen )
{
memset( szBuffer, ' ', uiLen );
return FALSE;
}
}
uiLen--;
for( iCount = 0; iCount < uiLen; iCount++ )
@@ -166,7 +166,7 @@ static BOOL hb_ndtoa( double dValue, char * szBuffer, USHORT uiLen, USHORT uiDec
{
memset( szBuffer, ' ', uiLen );
return FALSE;
}
}
szEndChar = szBuffer[ uiLen ];
sprintf( szBuffer, "%*.*f", uiLen, uiDec, dValue );
szBuffer[ uiLen ] = szEndChar;
@@ -628,7 +628,7 @@ static ERRCODE AddField( AREAP pArea, LPDBFIELDINFO pFieldInfo )
static ERRCODE Append( AREAP pArea, BOOL bUnLockAll )
{
ULONG lRecCount, lRecNo;
if( SELF_RECCOUNT( pArea, &lRecCount ) == FAILURE )
return FAILURE;
@@ -815,10 +815,9 @@ static ERRCODE GetValue( AREAP pArea, USHORT uiIndex, PHB_ITEM pItem )
szEndChar = * ( szText + pField->uiLen );
* ( szText + pField->uiLen ) = '\0';
if( pField->uiDec )
hb_itemPutND( pItem, atof( ( char * ) szText ) );
hb_itemPutNDLen( pItem, atof( ( char * ) szText ), ( WORD ) pField->uiLen, ( WORD ) pField->uiDec );
else
hb_itemPutNL( pItem, atol( ( char * ) szText ) );
hb_itemSetNLen( pItem, ( WORD ) pField->uiLen, ( WORD ) pField->uiDec );
hb_itemPutNLLen( pItem, atol( ( char * ) szText ), ( WORD ) pField->uiLen );
* ( szText + pField->uiLen ) = szEndChar;
break;
@@ -844,7 +843,7 @@ static ERRCODE GetValue( AREAP pArea, USHORT uiIndex, PHB_ITEM pItem )
hb_itemPutC( pItem, "" );
break;
}
return SUCCESS;
}
@@ -872,7 +871,7 @@ static ERRCODE GetVarLen( AREAP pArea, USHORT uiIndex, ULONG * ulLen )
static ERRCODE GoBottom( AREAP pArea )
{
ULONG lRecCount;
if( SELF_RECCOUNT( pArea, &lRecCount ) == FAILURE )
return FAILURE;
@@ -882,7 +881,7 @@ static ERRCODE GoBottom( AREAP pArea )
static ERRCODE GoTo( AREAP pArea, ULONG lRecNo )
{
ULONG lRecCount;
if( pArea->lpExtendInfo->fRecordChanged &&
!hb_dbfUpdateRecord(pArea, pArea->lpExtendInfo->lRecNo ) )
return FAILURE;
@@ -1004,11 +1003,11 @@ static ERRCODE Open( AREAP pArea, LPDBOPENINFO pOpenInfo )
if( SUPER_OPEN( pArea, pOpenInfo ) == FAILURE )
return FAILURE;
uiFlags = pOpenInfo->fReadonly ? FO_READ : FO_READWRITE;
uiFlags |= pOpenInfo->fShared ? FO_DENYNONE : FO_EXCLUSIVE;
pArea->lpFileInfo->hFile = hb_fsOpen( pOpenInfo->abName, uiFlags );
if( pArea->lpFileInfo->hFile == FS_ERROR )
{
SELF_CLOSE( pArea );
@@ -1281,14 +1280,14 @@ static ERRCODE ReadDBHeader( AREAP pArea )
for( uiFields = 0; uiFields < uiDataLen; uiFields += 32 )
if( szBuffer[ uiFields ] == 0xD )
break;
uiFields /= 32;
if( ( uiDataLen / 32 ) < uiFields )
{
hb_xfree( szBuffer );
return FAILURE;
}
pArea->lpExtendInfo->uiRecordLen = 1;
SELF_SETFIELDEXTENT( pArea, uiFields );
pFieldInfo.typeExtended = 0;

66
harbour/source/rtl/do.c
View File

@@ -84,45 +84,53 @@
*/
HARBOUR HB_DO( void )
{
PHB_ITEM pItem = hb_param( 1, IT_ANY );
int iPCount = hb_pcount();
if( IS_STRING( pItem ) )
if( iPCount >= 1 )
{
PHB_DYNS pDynSym = hb_dynsymGet( pItem->item.asString.value );
PHB_ITEM pItem = hb_param( 1, IT_ANY );
if( pDynSym )
if( IS_STRING( pItem ) )
{
PHB_DYNS pDynSym = hb_dynsymGet( hb_itemGetCPtr( pItem ) );
if( pDynSym )
{
int i;
hb_vmPushSymbol( pDynSym->pSymbol );
hb_vmPushNil();
for( i = 2; i <= iPCount; i++ )
hb_vmPush( hb_param( i, IT_ANY ) );
hb_vmDo( iPCount - 1 );
}
else
hb_errRT_BASE( EG_NOFUNC, 1001, NULL, pItem->item.asString.value );
}
else if( IS_BLOCK( pItem ) )
{
int i;
hb_vmPushSymbol( pDynSym->pSymbol );
hb_vmPushNil();
for( i = 2; i <= hb_pcount(); i++ )
hb_vmPushSymbol( &symEval );
hb_vmPush( pItem );
for( i = 2; i <= iPCount; i++ )
hb_vmPush( hb_param( i, IT_ANY ) );
hb_vmDo( hb_pcount() - 1 );
hb_vmDo( iPCount - 1 );
}
else if( IS_SYMBOL( pItem ) )
{
int i;
hb_vmPushSymbol( pItem->item.asSymbol.value );
hb_vmPushNil();
for( i = 2; i <= iPCount; i++ )
hb_vmPush( hb_param( i, IT_ANY ) );
hb_vmDo( iPCount - 1 );
}
else
hb_errRT_BASE( EG_NOFUNC, 1001, NULL, pItem->item.asString.value );
}
else if( IS_BLOCK( pItem ) )
{
int i;
hb_vmPushSymbol( &symEval );
hb_vmPush( pItem );
for( i = 2; i <= hb_pcount(); i++ )
hb_vmPush( hb_param( i, IT_ANY ) );
hb_vmDo( hb_pcount() - 1 );
}
else if( IS_SYMBOL( pItem ) )
{
int i;
hb_vmPushSymbol( pItem->item.asSymbol.value );
hb_vmPushNil();
for( i = 2; i <= hb_pcount(); i++ )
hb_vmPush( hb_param( i, IT_ANY ) );
hb_vmDo( hb_pcount() - 1 );
hb_errRT_BASE( EG_ARG, 3012, NULL, "DO" );
}
else
hb_errRT_BASE( EG_ARG, 3012, NULL, "DO" );
}

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

@@ -119,9 +119,6 @@ WORD hb_errLaunch( PHB_ITEM pError )
if( pError )
{
EVALINFO eval;
PHB_ITEM pBlock;
PHB_ITEM pObject;
PHB_ITEM pResult;
/* Check if we have a valid error handler */
@@ -134,21 +131,11 @@ WORD hb_errLaunch( PHB_ITEM pError )
if( s_iLaunchCount == HB_ERROR_LAUNCH_MAX )
hb_errInternal( 9999, "Too many recursive error handler calls", NULL, NULL );
s_iLaunchCount++;
/* Launch the error handler: "lResult := EVAL( ErrorBlock(), oError )" */
pBlock = hb_itemNew( NULL );
pObject = hb_itemNew( NULL );
s_iLaunchCount++;
hb_itemCopy( pBlock, &s_errorBlock );
hb_itemCopy( pObject, pError );
hb_evalNew( &eval, pBlock );
hb_evalPutParam( &eval, pObject );
pResult = hb_evalLaunch( &eval );
hb_evalRelease( &eval );
pResult = hb_itemDo( &s_errorBlock, 1, pError );
s_iLaunchCount--;
@@ -212,10 +199,6 @@ PHB_ITEM hb_errLaunchSubst( PHB_ITEM pError )
if( pError )
{
EVALINFO eval;
PHB_ITEM pBlock;
PHB_ITEM pObject;
/* Check if we have a valid error handler */
if( hb_itemType( &s_errorBlock ) != IT_BLOCK )
@@ -226,21 +209,11 @@ PHB_ITEM hb_errLaunchSubst( PHB_ITEM pError )
if( s_iLaunchCount == HB_ERROR_LAUNCH_MAX )
hb_errInternal( 9999, "Too many recursive ERRORBLOCK() calls", NULL, NULL );
s_iLaunchCount++;
/* Launch the error handler: "xResult := EVAL( ErrorBlock(), oError )" */
pBlock = hb_itemNew( NULL );
pObject = hb_itemNew( NULL );
s_iLaunchCount++;
hb_itemCopy( pBlock, &s_errorBlock );
hb_itemCopy( pObject, pError );
hb_evalNew( &eval, pBlock );
hb_evalPutParam( &eval, pObject );
pResult = hb_evalLaunch( &eval );
hb_evalRelease( &eval );
pResult = hb_itemDo( &s_errorBlock, 1, pError );
s_iLaunchCount--;

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

@@ -479,39 +479,17 @@ void hb_retnl( long lNumber )
void hb_retndlen( double dNumber, WORD wWidth, WORD wDecimal )
{
if( wWidth == 0 || wWidth > 99 )
wWidth = ( dNumber > 10000000000.0 ) ? 20 : 10;
if( wDecimal == ( ( WORD ) -1 ) || ( wDecimal != 0 && wDecimal >= ( wWidth - 1 ) ) )
wDecimal = hb_set.HB_SET_DECIMALS;
hb_itemClear( &stack.Return );
stack.Return.type = IT_DOUBLE;
stack.Return.item.asDouble.value = dNumber;
stack.Return.item.asDouble.length = wWidth;
stack.Return.item.asDouble.decimal = wDecimal;
hb_itemPutNDLen( &stack.Return, dNumber, wWidth, wDecimal );
}
void hb_retnilen( int iNumber, WORD wWidth )
{
if( wWidth == 0 || wWidth > 99 )
wWidth = 10;
hb_itemClear( &stack.Return );
stack.Return.type = IT_INTEGER;
stack.Return.item.asInteger.value = iNumber;
stack.Return.item.asInteger.length = wWidth;
hb_itemPutNILen( &stack.Return, iNumber, wWidth );
}
void hb_retnllen( long lNumber, WORD wWidth )
{
if( wWidth == 0 || wWidth > 99 )
wWidth = 10;
hb_itemClear( &stack.Return );
stack.Return.type = IT_LONG;
stack.Return.item.asLong.value = lNumber;
stack.Return.item.asLong.length = wWidth;
hb_itemPutNLLen( &stack.Return, lNumber, wWidth );
}
void hb_storc( char * szText, int iParam, ... )

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

@@ -25,12 +25,17 @@
/* Harbour Project source code
http://www.Harbour-Project.org/
The following functions are Copyright 1999 Victor Szel <info@szelvesz.hu>:
hb_itemDo() ( based on HB_DO() by Ryszard Glab )
hb_itemDoC() ( based on HB_DO() by Ryszard Glab )
hb_itemPutNI()
hb_itemGetNI()
hb_itemGetCPtr()
hb_itemGetCLen()
hb_itemGetNLen()
hb_itemSetNLen()
hb_itemPutNDLen()
hb_itemPutNILen()
hb_itemPutNLLen()
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
*/
@@ -43,61 +48,42 @@
BOOL hb_evalNew( PEVALINFO pEvalInfo, PHB_ITEM pItem )
{
BOOL bResult = FALSE;
BOOL bResult;
if( pEvalInfo )
{
memset( pEvalInfo, 0, sizeof( EVALINFO ) );
pEvalInfo->pItems[ 0 ] = pItem;
pEvalInfo->paramCount = 0;
bResult = TRUE;
}
else
bResult = FALSE;
return bResult;
}
/* NOTE: CA-Cl*pper is buggy and will not check if more parameters are
added than the maximum (9) .*/
BOOL hb_evalPutParam( PEVALINFO pEvalInfo, PHB_ITEM pItem )
{
BOOL bResult = FALSE;
BOOL bResult;
if( pEvalInfo )
if( pEvalInfo && pItem && pEvalInfo->paramCount < HB_EVAL_PARAM_MAX_ )
{
WORD w;
for( w = 1; w < HB_EVAL_PARAM_MAX_ + 1; w++ ) /* note that 0 position is used by the codeblock or function name item */
{
if( pEvalInfo->pItems[ w ] == NULL )
{
pEvalInfo->pItems[ w ] = pItem;
bResult = TRUE;
break;
}
}
}
return bResult;
}
BOOL hb_evalRelease( PEVALINFO pEvalInfo )
{
BOOL bResult = FALSE;
if( pEvalInfo )
{
WORD w;
for( w = 0; w < HB_EVAL_PARAM_MAX_ + 1; w++ )
/* NOTE: NULL pointer is checked by hb_itemRelease() */
hb_itemRelease( pEvalInfo->pItems[ w ] );
pEvalInfo->pItems[ ++pEvalInfo->paramCount ] = pItem;
bResult = TRUE;
}
else
bResult = FALSE;
return bResult;
}
PHB_ITEM hb_evalLaunch( PEVALINFO pEvalInfo )
{
PHB_ITEM pResult = NULL;
PHB_ITEM pResult;
if( pEvalInfo )
{
@@ -107,9 +93,9 @@ PHB_ITEM hb_evalLaunch( PEVALINFO pEvalInfo )
{
hb_vmPushSymbol( hb_dynsymGet( hb_itemGetC( pEvalInfo->pItems[ 0 ] ) )->pSymbol );
hb_vmPushNil();
while( w < ( HB_EVAL_PARAM_MAX_ + 1 ) && pEvalInfo->pItems[ w ] )
while( w <= pEvalInfo->paramCount )
hb_vmPush( pEvalInfo->pItems[ w++ ] );
hb_vmDo( w - 1 );
hb_vmDo( pEvalInfo->paramCount );
pResult = hb_itemNew( NULL );
hb_itemCopy( pResult, &stack.Return );
@@ -118,14 +104,150 @@ PHB_ITEM hb_evalLaunch( PEVALINFO pEvalInfo )
{
hb_vmPushSymbol( &symEval );
hb_vmPush( pEvalInfo->pItems[ 0 ] );
while( w < ( HB_EVAL_PARAM_MAX_ + 1 ) && pEvalInfo->pItems[ w ] )
while( w <= pEvalInfo->paramCount )
hb_vmPush( pEvalInfo->pItems[ w++ ] );
hb_vmDo( w - 1 );
hb_vmDo( pEvalInfo->paramCount );
pResult = hb_itemNew( NULL );
hb_itemCopy( pResult, &stack.Return );
}
else
pResult = NULL;
}
else
pResult = NULL;
return pResult;
}
BOOL hb_evalRelease( PEVALINFO pEvalInfo )
{
BOOL bResult;
if( pEvalInfo )
{
WORD w;
for( w = 0; w <= pEvalInfo->paramCount; w++ )
{
hb_itemRelease( pEvalInfo->pItems[ w ] );
pEvalInfo->pItems[ w ] = NULL;
}
pEvalInfo->paramCount = 0;
bResult = TRUE;
}
else
bResult = FALSE;
return bResult;
}
/* NOTE: Same purpose as hb_evalLaunch(), but simpler, faster and more flexible.
It can be used to call symbols, functions names, or blocks, the items
don't need to be duplicated when passed as argument, one line is
enough to initiate a call, the number of parameters is not limited. */
PHB_ITEM hb_itemDo( PHB_ITEM pItem, USHORT uiPCount, ... )
{
PHB_ITEM pResult;
if( pItem )
{
if( IS_STRING( pItem ) )
{
PHB_DYNS pDynSym = hb_dynsymGet( hb_itemGetCPtr( pItem ) );
if( pDynSym )
{
USHORT uiParam;
va_list va;
va_start( va, uiPCount );
hb_vmPushSymbol( pDynSym->pSymbol );
hb_vmPushNil();
for( uiParam = 1; uiParam <= uiPCount; uiParam++ )
hb_vmPush( va_arg( va, PHB_ITEM ) );
hb_vmDo( uiPCount );
va_end( va );
pResult = hb_itemNew( NULL );
hb_itemCopy( pResult, &stack.Return );
}
}
else if( IS_BLOCK( pItem ) )
{
USHORT uiParam;
va_list va;
va_start( va, uiPCount );
hb_vmPushSymbol( &symEval );
hb_vmPush( pItem );
for( uiParam = 1; uiParam <= uiPCount; uiParam++ )
hb_vmPush( va_arg( va, PHB_ITEM ) );
hb_vmDo( uiPCount );
va_end( va );
pResult = hb_itemNew( NULL );
hb_itemCopy( pResult, &stack.Return );
}
else if( IS_SYMBOL( pItem ) )
{
USHORT uiParam;
va_list va;
va_start( va, uiPCount );
hb_vmPushSymbol( pItem->item.asSymbol.value );
hb_vmPushNil();
for( uiParam = 1; uiParam <= uiPCount; uiParam++ )
hb_vmPush( va_arg( va, PHB_ITEM ) );
hb_vmDo( uiPCount );
va_end( va );
pResult = hb_itemNew( NULL );
hb_itemCopy( pResult, &stack.Return );
}
else
pResult = NULL;
}
else
pResult = NULL;
return pResult;
}
/* NOTE: Same as hb_itemDo(), but even simpler, since the function name can be
directly passed as a zero terminated string. */
PHB_ITEM hb_itemDoC( char * szFunc, USHORT uiPCount, ... )
{
PHB_ITEM pResult;
if( szFunc )
{
PHB_DYNS pDynSym = hb_dynsymGet( szFunc );
if( pDynSym )
{
USHORT uiParam;
va_list va;
va_start( va, uiPCount );
hb_vmPushSymbol( pDynSym->pSymbol );
hb_vmPushNil();
for( uiParam = 1; uiParam <= uiPCount; uiParam++ )
hb_vmPush( va_arg( va, PHB_ITEM ) );
hb_vmDo( uiPCount );
va_end( va );
pResult = hb_itemNew( NULL );
hb_itemCopy( pResult, &stack.Return );
}
else
pResult = NULL;
}
else
pResult = NULL;
return pResult;
}
@@ -286,8 +408,8 @@ BOOL hb_itemFreeC( char * szText )
}
/* NOTE: Clipper is buggy and will not append a trailing zero, although
the NG says that it will. Check your buffers, since what may have
worked with Clipper could overrun the buffer with Harbour.
the NG says that it will. Check your buffers, since what may have
worked with Clipper could overrun the buffer with Harbour.
The correct buffer size is 9 bytes: char szDate[ 9 ] */
char * hb_itemGetDS( PHB_ITEM pItem, char * szDate )
@@ -474,6 +596,61 @@ PHB_ITEM hb_itemPutNL( PHB_ITEM pItem, long lNumber )
return pItem;
}
PHB_ITEM hb_itemPutNDLen( PHB_ITEM pItem, double dNumber, WORD wWidth, WORD wDecimal )
{
if( pItem )
hb_itemClear( pItem );
else
pItem = hb_itemNew( NULL );
if( wWidth == 0 || wWidth > 99 )
wWidth = ( dNumber > 10000000000.0 ) ? 20 : 10;
if( wDecimal == ( ( WORD ) -1 ) || ( wDecimal != 0 && wDecimal >= ( wWidth - 1 ) ) )
wDecimal = hb_set.HB_SET_DECIMALS;
pItem->type = IT_DOUBLE;
pItem->item.asDouble.length = wWidth;
pItem->item.asDouble.decimal = wDecimal;
pItem->item.asDouble.value = dNumber;
return pItem;
}
PHB_ITEM hb_itemPutNILen( PHB_ITEM pItem, int iNumber, WORD wWidth )
{
if( pItem )
hb_itemClear( pItem );
else
pItem = hb_itemNew( NULL );
if( wWidth == 0 || wWidth > 99 )
wWidth = 10;
pItem->type = IT_INTEGER;
pItem->item.asInteger.length = wWidth;
pItem->item.asInteger.value = iNumber;
return pItem;
}
PHB_ITEM hb_itemPutNLLen( PHB_ITEM pItem, long lNumber, WORD wWidth )
{
if( pItem )
hb_itemClear( pItem );
else
pItem = hb_itemNew( NULL );
if( wWidth == 0 || wWidth > 99 )
wWidth = 10;
pItem->type = IT_LONG;
pItem->item.asLong.length = wWidth;
pItem->item.asLong.value = lNumber;
return pItem;
}
void hb_itemGetNLen( PHB_ITEM pItem, WORD * pwWidth, WORD * pwDecimal )
{
if( pItem )

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

@@ -2379,7 +2379,7 @@ void hb_vmRetValue( void )
hb_itemCopy( &stack.Return, stack.pPos ); /* copy it */
hb_itemClear( stack.pPos ); /* now clear it */
HB_DEBUG( "RetValue\n" );
HB_DEBUG( "hb_vmRetValue\n" );
}
void hb_stackPop( void )

2
harbour/source/vm/initsymb.c
View File

@@ -60,6 +60,7 @@ extern HARBOUR HB_RTRIM( void );
extern HARBOUR HB_SECONDS( void );
extern HARBOUR HB_SELECT( void );
extern HARBOUR HB_SETPOS( void );
extern HARBOUR HB_SETPOSBS( void );
extern HARBOUR HB_SPACE( void );
extern HARBOUR HB_SQRT( void );
extern HARBOUR HB_STR( void );
@@ -125,6 +126,7 @@ static HB_SYMB symbols[] = {
{ "SECONDS" , FS_PUBLIC, HB_SECONDS , 0 },
{ "SELECT" , FS_PUBLIC, HB_SELECT , 0 },
{ "SETPOS" , FS_PUBLIC, HB_SETPOS , 0 },
{ "SETPOSBS" , FS_PUBLIC, HB_SETPOSBS , 0 },
{ "SPACE" , FS_PUBLIC, HB_SPACE , 0 },
{ "SQRT" , FS_PUBLIC, HB_SQRT , 0 },
{ "STR" , FS_PUBLIC, HB_STR , 0 },

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

@@ -448,16 +448,16 @@ FUNCTION Main( cPar1 )
TEST_LINE( lcString >= 1 , "E BASE 1076 Argument error >= F:S" )
TEST_LINE( lcString <> 1 , "E BASE 1072 Argument error <> F:S" )
TEST_LINE( lcString == 1 , "E BASE 1070 Argument error == F:S" )
TEST_LINE( loObject == loObject , "E BASE 1070 Argument error == F:S" )
TEST_LINE( {} == {} , "E BASE 1070 Argument error == F:S" )
TEST_LINE( loObject == loObject , .T. )
TEST_LINE( loObject == ErrorNew() , .F. )
TEST_LINE( loObject == TBColumnNew() , .F. )
TEST_LINE( laArray == laArray , .T. )
TEST_LINE( {} == {} , .F. )
TEST_LINE( {|| NIL } == {|| NIL } , "E BASE 1070 Argument error == F:S" )
TEST_LINE( lcString = 1 , "E BASE 1071 Argument error = F:S" )
TEST_LINE( lcString < 1 , "E BASE 1073 Argument error < F:S" )
TEST_LINE( lcString <= 1 , "E BASE 1074 Argument error <= F:S" )
/* NOTE: Harbour RDD will GPF if commented out. */
#ifndef __HARBOUR__
/* NOTE: TEST_CALL() should be used here, since CA-Cl*pper can't preprocess
the TEST_LINE() variation properly. */
// TEST_LINE( ("NOTHERE")->NOFIELD , "E BASE 1002 Alias does not exist NOTHERE F:R" )
@@ -488,8 +488,6 @@ FUNCTION Main( cPar1 )
TEST_LINE( 200->({|| NIL }) , "{||...}" )
TEST_LINE( 200->(.T.) , .T. )
#endif
TEST_LINE( loObject:hello , "E BASE 1004 No exported method HELLO F:S" )
TEST_LINE( loObject:hello := 1 , "E BASE 1005 No exported variable HELLO F:S" )
@@ -697,6 +695,8 @@ FUNCTION Main( cPar1 )
TEST_LINE( PadR(NIL, 5) , "" )
TEST_LINE( PadR(.T., 5) , "" )
TEST_LINE( PadR(10, 5) , "10 " )
TEST_LINE( PadR(Year(SToD("19800101")), 5) , "1980 " )
TEST_LINE( PadR(Day(SToD("19800101")), 5) , "1 " )
TEST_LINE( PadR("abcdef", -5) , "" )
TEST_LINE( PadR("abcdef", 0) , "" )
TEST_LINE( PadR("abcdef", 5) , "abcde" )
@@ -709,6 +709,8 @@ FUNCTION Main( cPar1 )
TEST_LINE( PadL(NIL, 5) , "" )
TEST_LINE( PadL(.T., 5) , "" )
TEST_LINE( PadL(10, 5) , " 10" )
TEST_LINE( PadL(Year(SToD("19800101")), 5) , " 1980" )
TEST_LINE( PadL(Day(SToD("19800101")), 5) , " 1" )
TEST_LINE( PadL("abcdef", -5) , "" )
TEST_LINE( PadL("abcdef", 0) , "" )
TEST_LINE( PadL("abcdef", 5) , "abcde" ) /* QUESTION: CA-Cl*pper "bug", should return: "bcdef" ? */
@@ -721,6 +723,8 @@ FUNCTION Main( cPar1 )
TEST_LINE( PadC(NIL, 5) , "" )
TEST_LINE( PadC(.T., 5) , "" )
TEST_LINE( PadC(10, 5) , " 10 " )
TEST_LINE( PadC(Year(SToD("19800101")), 5) , "1980 " )
TEST_LINE( PadC(Day(SToD("19800101")), 5) , " 1 " )
TEST_LINE( PadC("abcdef", -5) , "" )
TEST_LINE( PadC("abcdef", 0) , "" )
TEST_LINE( PadC("abcdef", 2) , "ab" ) /* QUESTION: CA-Cl*pper "bug", should return: "cd" ? */