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

19990903-19:00 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-09-03 17:29:41 +00:00
parent 3783e1eacf
commit d2c28aaf4d
12 changed files with 224 additions and 206 deletions
Download Patch File Download Diff File Expand all files Collapse all files

50
harbour/ChangeLog
View File

@@ -1,3 +1,53 @@
19990903-19:00 GMT+1 Victor Szel <info@szelvesz.hu>
* source/itemapi.c
include/itemapi.h
+ hb_itemGetCPtr() function added. Use this with care, don't modify the
returned buffer. This is the fastest way to access a string buffer via
the standard API. The retval should really be declared const, but that
would generated a bunch of compiler warnings, so I didn't add it.
! hb_itemGetDS() made compliant with the Clipper NG, it now terminates
the date with a zero character, so the buffer needs to be 9 characters
long. Although Clipper itself is buggy in this respect and doesn't
append a trailing zero, even the example in the NG is buggy.
NOTE added about this.
* source/vm/hvm.c
* LEN(), EMPTY(), VALTYPE(), hb_stackDispLocal() (almost) now use no
internals, or uses Item API instead of Extend API, since it's faster
in their case.
* source/rtl/arrays.c
source/rtl/extend.c
include/extend.h
+ hb_arrayIsObject() function added.
* hb_arrayGetString() now uses hb_itemGetCPtr()
+ Copyright info added to arrays.c
! hb_arrayGetDate() now returns the date with a terminating zero.
* Small cosmetic change in array.c.
* source/rtl/extend.c
% hb_stor*() functions further optimized, usage of ulArrayIndex eliminated.
! One bug slipped in to one of the hb_stor*() functions at the previous
changes. Fixed. ( if -> else if )
+ NOTE added to hb_parc()
* hb_ret*() functions now uses Item API calls, this way a huge amount
or sensitive redundant code has been eliminated. Since these functions
are always called only once in Harbour callable function, the speed hit
should not be noticable (There's one more NULL check and a function
call). hb_retn?len() functions were not converted. We could make these
functions inline to speed it up. Notice that the size of extend.c has
been reduced from 23K to 17K.
; hb_par*() functions also have many redundant code, but it would be more
of a speed hit to convert them, since these are generally called several
times in a function, and two additional if()s would be also executed.
* source/compiler/harbour.y
+ The parameter count checking now shows the expected *range* in the
error message if applicable (not only the minimum number of params).
* tests/working/rtl_test.prg
+ Changed the column layout. Few new tests added (==).
* source/rtl/classes.c
% One variable eliminated (wIndex).
* source/rtl/dir.c
include/init.h
! Indenting errors fixed.
19990903-15:30 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/itemapi.c
% hb_itemPutDS() contained one more hb_itemClear() then needed.

1
harbour/include/extend.h
View File

@@ -279,6 +279,7 @@ extern ULONG hb_xsize( void * pMem ); /* returns the size of
extern BOOL hb_arrayError( PHB_ITEM pArray, ULONG ulIndex, BOOL bAssign ); /* Checks if the passed parameters are valid, launches runtim error if needed */
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 BOOL hb_arrayIsObject( PHB_ITEM pArray ); /* retrives if the array is an object */
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 );

70
harbour/include/init.h
View File

@@ -34,13 +34,13 @@ extern void hb_vmProcessSymbols( PHB_SYMB pSymbols, WORD wSymbols ); /* statics
#ifdef HARBOUR_STRICT_ANSI_C
#define HB_INIT_SYMBOLS_BEGIN( func ) \
static HB_SYMB symbols[] = {
static HB_SYMB symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
void func( void ) \
{ \
hb_vmProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
}
void func( void ) \
{ \
hb_vmProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
}
#define HB_CALL_ON_STARTUP_BEGIN( func ) func( void ) {
#define HB_CALL_ON_STARTUP_END( func ) }
@@ -49,17 +49,17 @@ extern void hb_vmProcessSymbols( PHB_SYMB pSymbols, WORD wSymbols ); /* statics
#ifdef __GNUC__
#define HB_INIT_SYMBOLS_BEGIN( func ) \
static HB_SYMB symbols[] = {
static HB_SYMB symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
void __attribute__ ((constructor)) func( void ) \
{ \
hb_vmProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
}
void __attribute__ ((constructor)) func( void ) \
{ \
hb_vmProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
}
#define HB_CALL_ON_STARTUP_BEGIN( func ) \
static void __attribute__ ((constructor)) func( void ) {
static void __attribute__ ((constructor)) func( void ) {
#define HB_CALL_ON_STARTUP_END( func ) }
#endif
@@ -67,56 +67,56 @@ extern void hb_vmProcessSymbols( PHB_SYMB pSymbols, WORD wSymbols ); /* statics
#ifdef __BORLANDC__
#define HB_INIT_SYMBOLS_BEGIN( func ) \
static HB_SYMB symbols[] = {
static HB_SYMB symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
void func( void ) \
{ \
hb_vmProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
}
void func( void ) \
{ \
hb_vmProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
}
#define HB_CALL_ON_STARTUP_BEGIN( func ) \
static void func( void ) {
static void func( void ) {
#define HB_CALL_ON_STARTUP_END( func ) }
#endif
#if (defined(_MSC_VER) || defined(__IBMCPP__) || defined(__MPW__))
#define HB_INIT_SYMBOLS_BEGIN( func ) \
static HB_SYMB symbols[] = {
static HB_SYMB symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
int func( void ) \
{ \
hb_vmProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
return 1; \
}; \
static int static_int_##func = func();
int func( void ) \
{ \
hb_vmProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
return 1; \
}; \
static int static_int_##func = func();
#define HB_CALL_ON_STARTUP_BEGIN( func ) \
static int func( void ) {
static int func( void ) {
#define HB_CALL_ON_STARTUP_END( func ) return 1; } \
static int static_int_##func = func();
static int static_int_##func = func();
#endif
#ifdef __WATCOMC__
#define HB_INIT_SYMBOLS_BEGIN( func ) \
static HB_SYMB symbols[] = {
static HB_SYMB symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
static int func( void ) \
{ \
hb_vmProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
return 1; \
}; \
static int static_int_##func = func();
static int func( void ) \
{ \
hb_vmProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
return 1; \
}; \
static int static_int_##func = func();
#define HB_CALL_ON_STARTUP_BEGIN( func ) \
static int func( void ) {
static int func( void ) {
#define HB_CALL_ON_STARTUP_END( func ) return 1; }; \
static int static_int_##func = func();
static int static_int_##func = func();
#endif
#endif /* HARBOUR_STRICT_ANSI_C */

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 char * hb_itemGetCPtr ( 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 );

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

@@ -5999,9 +5999,15 @@ void CheckArgs( char * szFuncCall, int iArgs )
{
if( iArgs < f[ iPos ].iMinParam || ( f[ iPos ].iMaxParam != -1 && iArgs > f[ iPos ].iMaxParam ) )
{
char szMsg[ 30 ];
char szMsg[ 40 ];
if( f[ iPos ].iMaxParam == -1 )
sprintf( szMsg, "\nPassed: %i, expected: at least %i", iArgs, f[ iPos ].iMinParam );
else if( f[ iPos ].iMinParam == f[ iPos ].iMaxParam )
sprintf( szMsg, "\nPassed: %i, expected: %i", iArgs, f[ iPos ].iMinParam );
else
sprintf( szMsg, "\nPassed: %i, expected: %i - %i", iArgs, f[ iPos ].iMinParam, f[ iPos ].iMaxParam );
sprintf( szMsg, " Passed: %i Expected: %i", iArgs, f[ iPos ].iMinParam );
GenError( _szCErrors, 'E', ERR_CHECKING_ARGS, szFuncCall, szMsg );
/* Clipper way */

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

@@ -22,6 +22,14 @@
You can contact me at: alinares@fivetech.com
*/
/* Harbour Project source code
http://www.Harbour-Project.org/
The following functions are Copyright 1999 Victor Szel <info@szelvesz.hu>:
hb_arrayIsObject()
hb_arrayError()
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
*/
#include "extend.h"
#include "itemapi.h"
#include "errorapi.h"
@@ -83,8 +91,16 @@ ULONG hb_arrayLen( PHB_ITEM pArray )
{
if( IS_ARRAY( pArray ) )
return pArray->item.asArray.value->ulLen;
else
return 0;
}
return 0;
BOOL hb_arrayIsObject( PHB_ITEM pArray )
{
if( IS_ARRAY( pArray ) )
return pArray->item.asArray.value->wClass != 0;
else
return FALSE;
}
BOOL hb_arraySize( PHB_ITEM pArray, ULONG ulLen )
@@ -242,7 +258,10 @@ char * hb_arrayGetDate( PHB_ITEM pArray, ULONG ulIndex, char * szDate )
hb_itemGetDS( pArray->item.asArray.value->pItems + ulIndex - 1, szDate );
}
else
{
memset( szDate, ' ', 8 );
szDate[ 8 ] = '\0';
}
return szDate;
}

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

@@ -614,10 +614,9 @@ char * hb_objGetClsName( PHB_ITEM pObject )
static HARBOUR hb___msgGetClsData( void )
{
WORD wClass = ( stack.pBase + 1 )->item.asArray.value->wClass;
WORD wIndex = s_pMethod->wData;
if( wClass && wClass <= s_wClasses )
hb_arrayGet( s_pClasses[ wClass - 1 ].pClassDatas, wIndex, &stack.Return );
hb_arrayGet( s_pClasses[ wClass - 1 ].pClassDatas, s_pMethod->wData, &stack.Return );
}

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

@@ -445,29 +445,29 @@ HARBOUR HB_DIRECTORY( void )
if( pos )
{
/* array cname, csize, ddate, ctime, cattributes */
pfilename = hb_itemPutC( NULL, filename );
psize = hb_itemPutC( NULL, filesize );
pdate = hb_itemPutDS( NULL, ddate );
ptime = hb_itemPutC( NULL, ttime );
pattr = hb_itemPutC( NULL, aatrib );
psubarray = hb_itemArrayNew( 5 );
hb_itemArrayPut( psubarray, 1, pfilename );
hb_itemArrayPut( psubarray, 2, psize );
hb_itemArrayPut( psubarray, 3, pdate );
hb_itemArrayPut( psubarray, 4, ptime );
hb_itemArrayPut( psubarray, 5, pattr );
/* array cname, csize, ddate, ctime, cattributes */
pfilename = hb_itemPutC( NULL, filename );
psize = hb_itemPutC( NULL, filesize );
pdate = hb_itemPutDS( NULL, ddate );
ptime = hb_itemPutC( NULL, ttime );
pattr = hb_itemPutC( NULL, aatrib );
psubarray = hb_itemArrayNew( 5 );
hb_itemArrayPut( psubarray, 1, pfilename );
hb_itemArrayPut( psubarray, 2, psize );
hb_itemArrayPut( psubarray, 3, pdate );
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 );
/* NOTE: Simply ignores the situation where the array length
limit is reached. */
hb_arrayAdd( pdir, psubarray );
hb_itemRelease( pfilename );
hb_itemRelease( psize );
hb_itemRelease( pdate );
hb_itemRelease( ptime );
hb_itemRelease( pattr );
hb_itemRelease( psubarray );
hb_itemRelease( pfilename );
hb_itemRelease( psize );
hb_itemRelease( pdate );
hb_itemRelease( ptime );
hb_itemRelease( pattr );
hb_itemRelease( psubarray );
}
}
}

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

@@ -69,6 +69,8 @@ PHB_ITEM hb_param( int iParam, WORD wMask )
return NULL;
}
/* NOTE: Caller should not modify the buffer returned by this function */
char * hb_parc( int iParam, ... )
{
if( ( iParam >= 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) )
@@ -205,7 +207,6 @@ char * hb_pards( int iParam, ... )
va_end( va );
hb_arrayGetDate( pItem, ulArrayIndex, stack.szDate );
stack.szDate[ 8 ] = '\0';
return stack.szDate; /* this guaranties good behavior when multithreading */
}
@@ -443,81 +444,43 @@ void hb_reta( ULONG ulLen ) /* undocumented hb_reta() */
void hb_retc( char * szText )
{
ULONG ulLen = strlen( szText );
hb_itemClear( &stack.Return );
stack.Return.type = IT_STRING;
stack.Return.item.asString.length = ulLen;
stack.Return.item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
strcpy( stack.Return.item.asString.value, szText );
hb_itemPutC( &stack.Return, szText );
}
void hb_retclen( char * szText, ULONG ulLen )
{
hb_itemClear( &stack.Return );
stack.Return.type = IT_STRING;
stack.Return.item.asString.length = ulLen;
stack.Return.item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
memcpy( stack.Return.item.asString.value, szText, ulLen );
stack.Return.item.asString.value[ ulLen ] = '\0';
hb_itemPutCL( &stack.Return, szText, ulLen );
}
void hb_retds( char * szDate ) /* szDate must have yyyymmdd format */
{
long lDay, lMonth, lYear;
hb_dateStrGet( szDate, &lDay, &lMonth, &lYear );
hb_itemClear( &stack.Return );
stack.Return.type = IT_DATE;
stack.Return.item.asDate.value = hb_dateEncode( lDay, lMonth, lYear );
hb_itemPutDS( &stack.Return, szDate );
}
void hb_retl( int iLogical )
{
hb_itemClear( &stack.Return );
stack.Return.type = IT_LOGICAL;
stack.Return.item.asLogical.value = iLogical ? TRUE : FALSE;
hb_itemPutL( &stack.Return, iLogical ? TRUE : FALSE );
}
void hb_retnd( double dNumber )
{
hb_itemClear( &stack.Return );
stack.Return.type = IT_DOUBLE;
if( dNumber > 10000000000.0 )
stack.Return.item.asDouble.length = 20;
else
stack.Return.item.asDouble.length = 10;
stack.Return.item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
stack.Return.item.asDouble.value = dNumber;
hb_itemPutND( &stack.Return, dNumber );
}
void hb_retni( int iNumber )
{
hb_itemClear( &stack.Return );
stack.Return.type = IT_INTEGER;
stack.Return.item.asInteger.length = 10;
stack.Return.item.asInteger.value = iNumber;
hb_itemPutNI( &stack.Return, iNumber );
}
void hb_retnl( long lNumber )
{
hb_itemClear( &stack.Return );
stack.Return.type = IT_LONG;
stack.Return.item.asLong.length = 10;
stack.Return.item.asLong.value = lNumber;
hb_itemPutNL( &stack.Return, lNumber );
}
void hb_retndlen( double dNumber, WORD wWidth, WORD wDecimal )
{
if( wWidth == 0 || wWidth > 99 )
{
if( dNumber > 10000000000.0 )
wWidth = 20;
else
wWidth = 10;
}
wWidth = ( dNumber > 10000000000.0 ) ? 20 : 10;
if( wDecimal == ( ( WORD ) -1 ) || ( wDecimal != 0 && wDecimal >= ( wWidth - 1 ) ) )
wDecimal = hb_set.HB_SET_DECIMALS;
@@ -563,15 +526,10 @@ void hb_storc( char * szText, int iParam, ... )
else if( IS_ARRAY( pItem ) )
{
va_list va;
ULONG ulArrayIndex;
PHB_ITEM pItemNew;
PHB_ITEM pItemNew = hb_itemPutC( NULL, szText );
va_start( va, iParam );
ulArrayIndex = va_arg( va, ULONG );
hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew );
va_end( va );
pItemNew = hb_itemPutC( NULL, szText );
hb_arraySet( pItem, ulArrayIndex, pItemNew );
hb_itemRelease( pItemNew );
}
}
@@ -591,15 +549,10 @@ void hb_storclen( char * szText, ULONG ulLen, int iParam, ... )
else if( IS_ARRAY( pItem ) )
{
va_list va;
ULONG ulArrayIndex;
PHB_ITEM pItemNew;
PHB_ITEM pItemNew = hb_itemPutCL( NULL, szText, ulLen );
va_start( va, iParam );
ulArrayIndex = va_arg( va, ULONG );
hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew );
va_end( va );
pItemNew = hb_itemPutCL( NULL, szText, ulLen );
hb_arraySet( pItem, ulArrayIndex, pItemNew );
hb_itemRelease( pItemNew );
}
}
@@ -607,7 +560,9 @@ void hb_storclen( char * szText, ULONG ulLen, int iParam, ... )
hb_itemPutCL( &stack.Return, szText, ulLen );
}
void hb_stords( char * szDate, int iParam, ... ) /* szDate must have yyyymmdd format */
/* szDate should have yyyymmdd format */
void hb_stords( char * szDate, int iParam, ... )
{
if( iParam > 0 && iParam <= hb_pcount() )
{
@@ -619,19 +574,14 @@ void hb_stords( char * szDate, int iParam, ... ) /* szDate must have yyyymmdd fo
else if( IS_ARRAY( pItem ) )
{
va_list va;
ULONG ulArrayIndex;
PHB_ITEM pItemNew;
PHB_ITEM pItemNew = hb_itemPutDS( NULL, szDate );
va_start( va, iParam );
ulArrayIndex = va_arg( va, ULONG );
hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew );
va_end( va );
pItemNew = hb_itemPutDS( NULL, szDate );
hb_arraySet( pItem, ulArrayIndex, pItemNew );
hb_itemRelease( pItemNew );
}
}
if( iParam == -1 )
else if( iParam == -1 )
hb_itemPutDS( &stack.Return, szDate );
}
@@ -647,15 +597,10 @@ void hb_storl( int iLogical, int iParam, ... )
else if( IS_ARRAY( pItem ) )
{
va_list va;
ULONG ulArrayIndex;
PHB_ITEM pItemNew;
PHB_ITEM pItemNew = hb_itemPutL( NULL, iLogical ? TRUE : FALSE );
va_start( va, iParam );
ulArrayIndex = va_arg( va, ULONG );
hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew );
va_end( va );
pItemNew = hb_itemPutL( NULL, iLogical ? TRUE : FALSE );
hb_arraySet( pItem, ulArrayIndex, pItemNew );
hb_itemRelease( pItemNew );
}
}
@@ -675,15 +620,10 @@ void hb_storni( int iValue, int iParam, ... )
else if( IS_ARRAY( pItem ) )
{
va_list va;
ULONG ulArrayIndex;
PHB_ITEM pItemNew;
PHB_ITEM pItemNew = hb_itemPutNI( NULL, iValue );
va_start( va, iParam );
ulArrayIndex = va_arg( va, ULONG );
hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew );
va_end( va );
pItemNew = hb_itemPutNI( NULL, iValue );
hb_arraySet( pItem, ulArrayIndex, pItemNew );
hb_itemRelease( pItemNew );
}
}
@@ -703,15 +643,10 @@ void hb_stornl( long lValue, int iParam, ... )
else if( IS_ARRAY( pItem ) )
{
va_list va;
ULONG ulArrayIndex;
PHB_ITEM pItemNew;
PHB_ITEM pItemNew = hb_itemPutNL( NULL, lValue );
va_start( va, iParam );
ulArrayIndex = va_arg( va, ULONG );
hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew );
va_end( va );
pItemNew = hb_itemPutNL( NULL, lValue );
hb_arraySet( pItem, ulArrayIndex, pItemNew );
hb_itemRelease( pItemNew );
}
}
@@ -719,31 +654,26 @@ void hb_stornl( long lValue, int iParam, ... )
hb_itemPutNL( &stack.Return, lValue );
}
void hb_stornd( double dValue, int iParam, ... )
void hb_stornd( double dNumber, int iParam, ... )
{
if( iParam > 0 && iParam <= hb_pcount() )
{
PHB_ITEM pItem = stack.pBase + 1 + iParam;
if( IS_BYREF( pItem ) )
hb_itemPutNI( hb_itemUnRef( pItem ), dValue );
hb_itemPutNI( hb_itemUnRef( pItem ), dNumber );
else if( IS_ARRAY( pItem ) )
{
va_list va;
ULONG ulArrayIndex;
PHB_ITEM pItemNew;
PHB_ITEM pItemNew = hb_itemPutND( NULL, dNumber );
va_start( va, iParam );
ulArrayIndex = va_arg( va, ULONG );
hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew );
va_end( va );
pItemNew = hb_itemPutND( NULL, dValue );
hb_arraySet( pItem, ulArrayIndex, pItemNew );
hb_itemRelease( pItemNew );
}
}
else if( iParam == -1 )
hb_itemPutND( &stack.Return, dValue );
hb_itemPutND( &stack.Return, dNumber );
}

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

@@ -27,6 +27,7 @@
The following functions are Copyright 1999 Victor Szel <info@szelvesz.hu>:
hb_itemPutNI()
hb_itemGetNI()
hb_itemGetCPtr()
hb_itemGetCLen()
hb_itemGetNLen()
hb_itemSetNLen()
@@ -238,6 +239,16 @@ char * hb_itemGetC( PHB_ITEM pItem )
return NULL;
}
/* NOTE: Caller should not modify the buffer returned by this function */
char * hb_itemGetCPtr( PHB_ITEM pItem )
{
if( pItem && IS_STRING( pItem ) )
return pItem->item.asString.value;
else
return NULL;
}
ULONG hb_itemGetCLen( PHB_ITEM pItem )
{
if( pItem && IS_STRING( pItem ) )
@@ -274,6 +285,11 @@ BOOL hb_itemFreeC( char * szText )
return bResult;
}
/* 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 correct buffer size is 9 bytes: char szDate[ 9 ] */
char * hb_itemGetDS( PHB_ITEM pItem, char * szDate )
{
if( pItem && IS_DATE( pItem ) )
@@ -286,6 +302,8 @@ char * hb_itemGetDS( PHB_ITEM pItem, char * szDate )
else
memset( szDate, ' ', 8 );
szDate[ 8 ] = '\0';
return szDate;
}
@@ -421,8 +439,7 @@ PHB_ITEM hb_itemPutND( PHB_ITEM pItem, double dNumber )
pItem = hb_itemNew( NULL );
pItem->type = IT_DOUBLE;
if( dNumber > 10000000000.0 ) pItem->item.asDouble.length = 20;
else pItem->item.asDouble.length = 10;
pItem->item.asDouble.length = ( dNumber > 10000000000.0 ) ? 20 : 10;
pItem->item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
pItem->item.asDouble.value = dNumber;

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

@@ -899,8 +899,8 @@ void hb_vmDimArray( WORD wDimensions ) /* generates a wDimensions Array and init
/*
for( w = 0; w < wElements; w++ )
hb_itemCopy( itArray.item.asArray.value->pItems + w,
stack.pPos - wElements + w );
hb_itemCopy( itArray.item.asArray.value->pItems + w,
stack.pPos - wElements + w );
*/
for( w = 0; w < wDimensions; w++ )
@@ -1203,7 +1203,7 @@ void hb_vmGenArray( WORD wElements ) /* generates a wElements Array and fills it
hb_arrayNew( &itArray, wElements );
for( w = 0; w < wElements; w++ )
hb_itemCopy( itArray.item.asArray.value->pItems + w,
stack.pPos - wElements + w );
stack.pPos - wElements + w );
for( w = 0; w < wElements; w++ )
hb_stackPop();
@@ -2451,17 +2451,14 @@ void hb_stackDispLocal( void )
for( pBase = stack.pBase; pBase <= stack.pPos; pBase++ )
{
switch( pBase->type )
switch( hb_itemType( pBase ) )
{
case IT_NIL:
printf( "NIL " );
break;
case IT_ARRAY:
if( pBase->item.asArray.value->wClass )
printf( "OBJECT " );
else
printf( "ARRAY " );
printf( hb_arrayIsObject( pBase ) ? "OBJECT " : "ARRAY " );
break;
case IT_BLOCK:
@@ -2477,7 +2474,7 @@ void hb_stackDispLocal( void )
break;
case IT_LOGICAL:
printf( "LOGICAL[%c] ", pBase->item.asLogical.value ? 'T' : 'F' );
printf( "LOGICAL[%c] ", hb_itemGetL( pBase ) ? 'T' : 'F' );
break;
case IT_LONG:
@@ -2485,7 +2482,7 @@ void hb_stackDispLocal( void )
break;
case IT_INTEGER:
printf( "INTEGER[%i] ", pBase->item.asInteger.value );
printf( "INTEGER[%i] ", hb_itemGetNI( pBase ) );
break;
case IT_STRING:
@@ -2497,7 +2494,7 @@ void hb_stackDispLocal( void )
break;
default:
printf( "UNKNOWN[%i] ", pBase->type );
printf( "UNKNOWN[%i] ", hb_itemType( pBase ) );
break;
}
}
@@ -2830,11 +2827,11 @@ HARBOUR HB_LEN( void )
switch( pItem->type )
{
case IT_ARRAY:
hb_retnl( pItem->item.asArray.value->ulLen );
hb_retnl( hb_arrayLen( pItem ) );
break;
case IT_STRING:
hb_retnl( pItem->item.asString.length );
hb_retnl( hb_itemGetCLen( pItem ) );
break;
default:
@@ -2857,31 +2854,32 @@ HARBOUR HB_EMPTY( void )
switch( pItem->type & ~IT_BYREF )
{
case IT_ARRAY:
hb_retl( pItem->item.asArray.value->ulLen == 0 );
hb_retl( hb_arrayLen( pItem ) == 0 );
break;
case IT_STRING:
hb_retl( hb_strEmpty( hb_parc( 1 ), hb_parclen( 1 ) ) );
hb_retl( hb_strEmpty( hb_itemGetCPtr( pItem ), hb_itemGetCLen( pItem ) ) );
break;
case IT_INTEGER:
hb_retl( ! hb_parni( 1 ) );
hb_retl( hb_itemGetNI( pItem ) == 0 );
break;
case IT_LONG:
hb_retl( ! hb_parnl( 1 ) );
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
case IT_DOUBLE:
hb_retl( ! hb_parnd( 1 ) );
hb_retl( hb_itemGetND( pItem ) == 0.0 );
break;
case IT_DATE:
hb_retl( atol( hb_pards( 1 ) ) == 0 ); /* Convert to long */
/* NOTE: This is correct ! Get the date as long value. */
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
case IT_LOGICAL:
hb_retl( ! hb_parl( 1 ) );
hb_retl( ! hb_itemGetL( pItem ) );
break;
case IT_BLOCK:
@@ -2908,10 +2906,7 @@ HARBOUR HB_VALTYPE( void )
switch( pItem->type & ~IT_BYREF )
{
case IT_ARRAY:
if( pItem->item.asArray.value->wClass )
hb_retc( "O" ); /* it is an object */
else
hb_retc( "A" );
hb_retc( hb_arrayIsObject( pItem ) ? "O" : "A" );
break;
case IT_BLOCK:

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

@@ -448,6 +448,8 @@ 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( {|| 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" )
@@ -1112,10 +1114,11 @@ FUNCTION Main( cPar1 )
RETURN NIL
#define TEST_RESULT_COL1_WIDTH 4
#define TEST_RESULT_COL2_WIDTH 30
#define TEST_RESULT_COL3_WIDTH 55
#define TEST_RESULT_COL4_WIDTH 40
#define TEST_RESULT_COL1_WIDTH 1
#define TEST_RESULT_COL2_WIDTH 4
#define TEST_RESULT_COL3_WIDTH 30
#define TEST_RESULT_COL4_WIDTH 55
#define TEST_RESULT_COL5_WIDTH 40
STATIC FUNCTION TEST_BEGIN( cParam )
LOCAL cOs := OS()
@@ -1160,12 +1163,12 @@ STATIC FUNCTION TEST_BEGIN( cParam )
" Switches: " + cParam + s_cNewLine +;
"===========================================================================" + s_cNewLine )
fWrite( s_nFhnd, PadL( "No", TEST_RESULT_COL1_WIDTH ) + ". " +;
PadR( "TestCall()", TEST_RESULT_COL2_WIDTH ) + " -> " +;
PadR( "Result", TEST_RESULT_COL3_WIDTH ) + " | " +;
PadR( "Expected", TEST_RESULT_COL4_WIDTH ) +;
" [! *FAIL* !]" + s_cNewLine )
fWrite( s_nFhnd, "---------------------------------------------------------------------------" + s_cNewLine )
fWrite( s_nFhnd, PadL( "R", TEST_RESULT_COL1_WIDTH ) + " " +;
PadL( "No", TEST_RESULT_COL2_WIDTH ) + ". " +;
PadR( "TestCall()", TEST_RESULT_COL3_WIDTH ) + " -> " +;
PadR( "Result", TEST_RESULT_COL4_WIDTH ) + " | " +;
PadR( "Expected", TEST_RESULT_COL5_WIDTH ) + s_cNewLine +;
"---------------------------------------------------------------------------" + s_cNewLine )
RETURN NIL
@@ -1209,14 +1212,11 @@ STATIC FUNCTION TEST_CALL( cBlock, bBlock, xResultExpected )
IF s_lShowAll .OR. lFailed
fWrite( s_nFhnd, Str( s_nCount, TEST_RESULT_COL1_WIDTH ) + ". " +;
PadR( cBlock, TEST_RESULT_COL2_WIDTH ) + " -> " +;
PadR( XToStr( xResult ), TEST_RESULT_COL3_WIDTH ) + " | " +;
PadR( XToStr( xResultExpected ), TEST_RESULT_COL4_WIDTH ) )
IF lFailed
fWrite( s_nFhnd, " ! *FAIL* !" )
ENDIF
fWrite( s_nFhnd, PadR( iif( lFailed, "!", " " ), TEST_RESULT_COL1_WIDTH ) + " " +;
Str( s_nCount, TEST_RESULT_COL2_WIDTH ) + ". " +;
PadR( cBlock, TEST_RESULT_COL3_WIDTH ) + " -> " +;
PadR( XToStr( xResult ), TEST_RESULT_COL4_WIDTH ) + " | " +;
PadR( XToStr( xResultExpected ), TEST_RESULT_COL5_WIDTH ) )
fWrite( s_nFhnd, s_cNewLine )
ENDIF