From 35cb4e4d1bf10b9b6463063d6511f2abd5e36c30 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Tue, 7 Sep 1999 15:18:27 +0000 Subject: [PATCH] 19990907-17:00 GMT+1 --- harbour/ChangeLog | 73 +++ harbour/include/extend.h | 2 +- harbour/source/rdd/dbf1.c | 2 +- harbour/source/rtl/arrays.c | 2 + harbour/source/rtl/classes.c | 17 +- harbour/source/rtl/descend.c | 27 +- harbour/source/rtl/do.c | 20 +- harbour/source/rtl/itemapi.c | 42 +- harbour/source/rtl/math.c | 202 ++++-- harbour/source/rtl/set.c | 12 +- harbour/source/rtl/strings.c | 101 +-- harbour/source/vm/hvm.c | 233 +++++-- harbour/tests/working/Makefile | 1 - harbour/tests/working/descend.prg | 64 -- harbour/tests/working/rtl_test.prg | 983 ++++++++++++++++------------- harbour/tests/working/testdbf.prg | 6 + 16 files changed, 1081 insertions(+), 706 deletions(-) delete mode 100644 harbour/tests/working/descend.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index aa23922403..e6de0431ca 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,76 @@ +19990907-17:00 GMT+1 Victor Szel + * source/vm/hvm.c + ! hb_vmEqual() is now Clipper compatible for ARRAY and BLOCK types. + ! hb_vmMinus() is now generating the result as LONG (instead of DOUBLE) + when the two operands are DATEs. + ! hb_vmDivide() fixed the decimal handling for integer operands with an + integer result. + ! hb_vmNegate() now handles the number width in a Clipper compatible way. + ! hb_vmEqual(), hb_vmNotEqual(), hb_vmLess*(), hb_vmGreater*(), hb_vmDo(), + hb_arrayAt() error handling now support value substitution. + hb_vmDo() and hb_vmArrayAt() should be tested, since I'm not exactly sure + if they are correctly pushing the result. + * source/rtl/strings.c + ! VAL() fixed to return INTEGER/LONG if applicable, not always a DOUBLE. + Similar logic can be found in hb_vmPushNumber(). + + REPLICATE() STROVERFLOW error now supports value substitution. + * hb_itemPadConv() now uses less internal, type checks reordered with the + most probable moved to the top. Some Extend API calls changed to Item API + ones, to make it faster. + ! hb_itemPadConv() was casting back DOUBLE value without decimals to LONG + to convert it to string. Corrected. There may be other places where + DOUBLE is converted to LONG, these should be revised, since a DOUBLE is + also used when there are *no* decimal places, but the value is too big + to fit in a LONG (like: 5000000000), for example INT() is buggy because + of that right now. + * tests/working/rtl_test.prg + + Some new decimal handling and ABS() tests added. + + Some divide and date subtracion tests added to decimal handling section. + + Some negate tests added to the decimal handling section. + + INT() tests added. + * LOCAL test values converted to STATIC, PRIVATE test values converted + to PUBLIC. + * Split the tests into smaller functions, since the 64K function limit + has been reached. + ! Expected results changed where we consider Clipper to be buggy, mainly + for cases when the parameters is passed by reference. + + SQRT() tests added. + * source/rdd/dbf1.c + ! Fixed the passed parameters to hb_itemPutNDLen() + * tests/working/testdbf.prg + + Numeric value put/get tests added. + * source/rtl/itemapi.c + ! hb_itemType() now checks for NULL parameters, like in Clipper. + ! hb_itemPutNDLen() was handling the wDec parameter in a wrong way by + mistake. I assumed that the wDec value means the decimal places within + the full length, but that was wrong. + ! hb_itemStrCmp() two LONGs changed to ULONG. + * source/rtl/math.c + % MOD() one Extend API call changed to Item API to make it faster. + + MIN()/MAX() now uses Item API instead of accessing internals. + + ABS() uses Item API instead of internals. + ! ABS() now keeps the width of the positive integers. + ! hb_numRound() now uses a much larger buffer (like in hb_itemStr()), this + seem to have fixed the random GPFs in Cygwin when running RTL_TEST. + Same type of dangerous code can be found in RDD/DBF1.C, too. (Bruno!) + + ABS(), INT(), ROUND(), EXP(), LOG(), SQRT(), MIN(), MAX() value + substitution added. + * source/rtl/descend.c + * Now using Item API only, internals totally eliminated. Simpler code, + some variables eliminated, some small optimalizations. + * source/rtl/do.c + * Value substitution added to EVAL(), DO() + * source/rtl/classes.c + * Value substitution added to :EVAL + * tests/working/descend.prg + tests/working/Makefile + - Removed since an automated version is already included in RTL_TEST. + * source/rtl/classes.c + source/rtl/arrays.c + + Copyright info added. + * source/rtl/set.c + ! Some minor formatting corrections. + 19990907-02:30 GMT+1 Victor Szel * include/external.ch source/runner/stdalone/external.prg diff --git a/harbour/include/extend.h b/harbour/include/extend.h index 94255b9cf1..ff6a2c72c4 100644 --- a/harbour/include/extend.h +++ b/harbour/include/extend.h @@ -311,7 +311,7 @@ extern PHB_ITEM hb_arrayClone( PHB_ITEM pArray ); #define HB_STRGREATER_RIGHT 2 extern int hb_stricmp( const char * s1, const char * s2 ); -extern int hb_strgreater( char * sz1, char * sz2 ); +extern int hb_strgreater( char * szText1, char * szText2 ); extern void hb_strupr( char * szText ); extern BOOL hb_strMatchRegExp( char * szString, char * szMask ); extern BOOL hb_strEmpty( char * szText, ULONG ulLen ); diff --git a/harbour/source/rdd/dbf1.c b/harbour/source/rdd/dbf1.c index 5bab5aeabb..3fbc8fd120 100644 --- a/harbour/source/rdd/dbf1.c +++ b/harbour/source/rdd/dbf1.c @@ -815,7 +815,7 @@ static ERRCODE GetValue( AREAP pArea, USHORT uiIndex, PHB_ITEM pItem ) szEndChar = * ( szText + pField->uiLen ); * ( szText + pField->uiLen ) = '\0'; if( pField->uiDec ) - hb_itemPutNDLen( pItem, atof( ( char * ) szText ), ( WORD ) pField->uiLen, ( WORD ) pField->uiDec ); + hb_itemPutNDLen( pItem, atof( ( char * ) szText ), ( WORD ) pField->uiLen - ( ( WORD ) pField->uiDec + 1 ), ( WORD ) pField->uiDec ); else hb_itemPutNLLen( pItem, atol( ( char * ) szText ), ( WORD ) pField->uiLen ); * ( szText + pField->uiLen ) = szEndChar; diff --git a/harbour/source/rtl/arrays.c b/harbour/source/rtl/arrays.c index dcbee8f3bb..0237d82bc3 100644 --- a/harbour/source/rtl/arrays.c +++ b/harbour/source/rtl/arrays.c @@ -27,6 +27,8 @@ The following functions are Copyright 1999 Victor Szel : hb_arrayIsObject() hb_arrayError() + hb_arrayCopyC() + hb_arrayGetC() See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms. */ diff --git a/harbour/source/rtl/classes.c b/harbour/source/rtl/classes.c index d18ce7c277..b0af0e4186 100644 --- a/harbour/source/rtl/classes.c +++ b/harbour/source/rtl/classes.c @@ -41,6 +41,13 @@ * __objSendMsg() */ +/* Harbour Project source code + http://www.Harbour-Project.org/ + The following functions are Copyright 1999 Victor Szel : + hb___msgEval() + See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms. +*/ + #include "extend.h" #include "errorapi.h" #include "itemapi.h" @@ -922,7 +929,15 @@ static HARBOUR hb___msgEval( void ) hb_vmDo( hb_pcount() ); /* Self is also an argument */ } else - hb_errRT_BASE( EG_NOMETHOD, 1004, NULL, "EVAL" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_NOMETHOD, 1004, NULL, "EVAL" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } diff --git a/harbour/source/rtl/descend.c b/harbour/source/rtl/descend.c index e3ea2f24da..cb1af187dd 100644 --- a/harbour/source/rtl/descend.c +++ b/harbour/source/rtl/descend.c @@ -84,30 +84,17 @@ HARBOUR HB_DESCEND( void ) { if( IS_STRING( pItem ) ) { - char * szBuffer = ( char * ) hb_xgrab( pItem->item.asString.length ); - hb_strDescend( szBuffer, pItem->item.asString.value, pItem->item.asString.length ); - hb_retclen( szBuffer, pItem->item.asString.length ); + ULONG ulLen = hb_itemGetCLen( pItem ); + char * szBuffer = ( char * ) hb_xgrab( ulLen ); + hb_strDescend( szBuffer, hb_itemGetCPtr( pItem ), ulLen ); + hb_retclen( szBuffer, ulLen ); hb_xfree( szBuffer ); } else if( IS_DATE( pItem ) ) - hb_retnl( 5231808 - pItem->item.asDate.value ); + hb_retnl( 5231808 - hb_itemGetNL( pItem ) ); else if( IS_NUMERIC( pItem ) ) - { - PHB_ITEM pReturn; - double dValue; - - if( IS_DOUBLE( pItem ) ) - dValue = pItem->item.asDouble.value; - else if( IS_INTEGER( pItem ) ) - dValue = ( double ) pItem->item.asInteger.value; - else if( IS_LONG( pItem ) ) - dValue = ( double ) pItem->item.asLong.value; - - pReturn = hb_itemPutND( NULL, -1 * dValue ); - hb_itemReturn( pReturn ); - hb_itemRelease( pReturn ); - } + hb_retnd( -1 * hb_itemGetND( pItem ) ); else if( IS_LOGICAL( pItem ) ) - hb_retl( ! pItem->item.asLogical.value ); + hb_retl( ! hb_itemGetL( pItem ) ); } } diff --git a/harbour/source/rtl/do.c b/harbour/source/rtl/do.c index 86255bc851..99106bb9a5 100644 --- a/harbour/source/rtl/do.c +++ b/harbour/source/rtl/do.c @@ -128,7 +128,15 @@ HARBOUR HB_DO( void ) hb_vmDo( uiPCount - 1 ); } else - hb_errRT_BASE( EG_ARG, 3012, NULL, "DO" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 3012, NULL, "DO" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } else hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "DO" ); @@ -153,7 +161,15 @@ HARBOUR HB_EVAL( void ) hb_vmDo( uiPCount - 1 ); } else - hb_errRT_BASE( EG_NOMETHOD, 1004, NULL, "EVAL" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_NOMETHOD, 1004, NULL, "EVAL" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } else hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "EVAL" ); /* NOTE: Clipper catches this at compile time! */ diff --git a/harbour/source/rtl/itemapi.c b/harbour/source/rtl/itemapi.c index cf2b8d6f23..da7e8b97ae 100644 --- a/harbour/source/rtl/itemapi.c +++ b/harbour/source/rtl/itemapi.c @@ -605,7 +605,7 @@ PHB_ITEM hb_itemPutNDLen( PHB_ITEM pItem, double dNumber, WORD wWidth, WORD wDec if( wWidth == 0 || wWidth > 99 ) wWidth = ( dNumber > 10000000000.0 ) ? 20 : 10; - if( wDecimal == ( ( WORD ) -1 ) || ( wDecimal != 0 && wDecimal >= ( wWidth - 1 ) ) ) + if( wDecimal == ( ( WORD ) -1 ) ) wDecimal = hb_set.HB_SET_DECIMALS; pItem->type = IT_DOUBLE; @@ -674,7 +674,6 @@ void hb_itemGetNLen( PHB_ITEM pItem, WORD * pwWidth, WORD * pwDecimal ) default: if( pwWidth ) *pwWidth = 0; if( pwDecimal ) *pwDecimal = 0; - break; } } } @@ -698,7 +697,10 @@ ULONG hb_itemSize( PHB_ITEM pItem ) WORD hb_itemType( PHB_ITEM pItem ) { - return pItem->type; + if( pItem ) + return pItem->type; + else + return IT_NIL; } /* Internal API, not standard Clipper */ @@ -801,28 +803,28 @@ PHB_ITEM hb_itemUnRef( PHB_ITEM pItem ) /* Check whether two strings are equal (0), smaller (-1), or greater (1) */ int hb_itemStrCmp( PHB_ITEM pFirst, PHB_ITEM pSecond, BOOL bForceExact ) { - char * szFirst = pFirst->item.asString.value; - char * szSecond = pSecond->item.asString.value; - ULONG lLenFirst = pFirst->item.asString.length; - ULONG lLenSecond = pSecond->item.asString.length; - LONG lMinLen; - LONG lCounter; + char * szFirst = pFirst->item.asString.value; + char * szSecond = pSecond->item.asString.value; + ULONG ulLenFirst = pFirst->item.asString.length; + ULONG ulLenSecond = pSecond->item.asString.length; + ULONG ulMinLen; + ULONG ulCounter; int iRet = 0; /* Current status */ if( hb_set.HB_SET_EXACT && !bForceExact ) { /* SET EXACT ON and not using == */ /* Don't include trailing spaces */ - while( lLenFirst > 0 && szFirst[ lLenFirst - 1 ] == ' ' ) lLenFirst--; - while( lLenSecond > 0 && szSecond[ lLenSecond - 1 ] == ' ' ) lLenSecond--; + while( ulLenFirst > 0 && szFirst[ ulLenFirst - 1 ] == ' ' ) ulLenFirst--; + while( ulLenSecond > 0 && szSecond[ ulLenSecond - 1 ] == ' ' ) ulLenSecond--; } - lMinLen = lLenFirst < lLenSecond ? lLenFirst : lLenSecond; + ulMinLen = ulLenFirst < ulLenSecond ? ulLenFirst : ulLenSecond; /* One of the strings is empty */ - if( lMinLen ) + if( ulMinLen ) { - for( lCounter = 0; lCounter < lMinLen && !iRet; lCounter++ ) + for( ulCounter = 0; ulCounter < ulMinLen && !iRet; ulCounter++ ) { /* Difference found */ if( *szFirst != *szSecond ) @@ -833,23 +835,23 @@ int hb_itemStrCmp( PHB_ITEM pFirst, PHB_ITEM pSecond, BOOL bForceExact ) szSecond++; } } - if( hb_set.HB_SET_EXACT || bForceExact || lLenSecond > lCounter ) + if( hb_set.HB_SET_EXACT || bForceExact || ulLenSecond > ulCounter ) { /* Force an exact comparison */ - if( !iRet && lLenFirst != lLenSecond ) + if( !iRet && ulLenFirst != ulLenSecond ) /* If length is different ! */ - iRet = ( lLenFirst < lLenSecond ) ? -1 : 1; + iRet = ( ulLenFirst < ulLenSecond ) ? -1 : 1; } } else { /* Both empty ? */ - if( lLenFirst != lLenSecond ) + if( ulLenFirst != ulLenSecond ) { if( hb_set.HB_SET_EXACT || bForceExact ) - iRet = ( lLenFirst < lLenSecond ) ? -1 : 1; + iRet = ( ulLenFirst < ulLenSecond ) ? -1 : 1; else - iRet = ( lLenSecond == 0 ) ? 0 : -1; + iRet = ( ulLenSecond == 0 ) ? 0 : -1; } else /* Both empty => Equal ! */ diff --git a/harbour/source/rtl/math.c b/harbour/source/rtl/math.c index 55f2496f77..3ac1a0a2b6 100644 --- a/harbour/source/rtl/math.c +++ b/harbour/source/rtl/math.c @@ -10,7 +10,6 @@ #include #include "extend.h" -#include "set.h" #include "itemapi.h" #include "errorapi.h" @@ -20,30 +19,48 @@ HARBOUR HB_ABS( void ) { PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); - if( pNumber ) switch( pNumber->type ) + if( pNumber ) { - case IT_INTEGER: - if( pNumber->item.asInteger.value >= 0 ) - hb_retni( pNumber->item.asInteger.value ); - else - hb_retni( -pNumber->item.asInteger.value ); - break; + WORD wWidth; + WORD wDec; - case IT_LONG: - if( pNumber->item.asLong.value >= 0 ) - hb_retnl( pNumber->item.asLong.value ); - else - hb_retnl( -pNumber->item.asLong.value ); - break; + hb_itemGetNLen( pNumber, &wWidth, &wDec ); - case IT_DOUBLE: - if( pNumber->item.asDouble.value >= 0.0 ) - hb_retndlen( pNumber->item.asDouble.value, 0, pNumber->item.asDouble.decimal ); + if( IS_INTEGER( pNumber ) ) + { + int iNumber = hb_itemGetNI( pNumber ); + + if( iNumber >= 0 ) + hb_retnilen( iNumber, wWidth ); else - hb_retndlen( -pNumber->item.asDouble.value, 0, pNumber->item.asDouble.decimal ); + hb_retni( -iNumber ); + } + else if( IS_LONG( pNumber ) ) + { + long lNumber = hb_itemGetNL( pNumber ); + + if( lNumber >= 0 ) + hb_retnllen( lNumber, wWidth ); + else + hb_retnl( -lNumber ); + } + else if( IS_DOUBLE( pNumber ) ) + { + double dNumber = hb_itemGetND( pNumber ); + + hb_retndlen( dNumber >= 0.0 ? dNumber : -dNumber, 0, wDec ); + } } else - hb_errRT_BASE( EG_ARG, 1089, NULL, "ABS" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1089, NULL, "ABS" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } else hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "ABS" ); /* NOTE: Clipper catches this at compile time! */ @@ -56,7 +73,15 @@ HARBOUR HB_EXP( void ) if( ISNUM( 1 ) ) hb_retnd( exp( hb_parnd( 1 ) ) ); else - hb_errRT_BASE( EG_ARG, 1096, NULL, "EXP" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1096, NULL, "EXP" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } else hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "EXP" ); /* NOTE: Clipper catches this at compile time! */ @@ -66,10 +91,26 @@ HARBOUR HB_INT( void ) { if( hb_pcount() == 1 ) { - if( ISNUM( 1 ) ) - hb_retnl( hb_parnd( 1 ) ); + PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); + + if( pNumber ) + { + WORD wWidth; + + hb_itemGetNLen( pNumber, &wWidth, NULL ); + + hb_retndlen( ( long ) hb_parnd( 1 ), wWidth, 0 ); + } else - hb_errRT_BASE( EG_ARG, 1090, NULL, "INT" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1090, NULL, "INT" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } else hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "INT" ); /* NOTE: Clipper catches this at compile time! */ @@ -90,7 +131,15 @@ HARBOUR HB_LOG( void ) hb_retnd( log( dNumber ) ); } else - hb_errRT_BASE( EG_ARG, 1095, NULL, "LOG" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1095, NULL, "LOG" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } else hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "LOG" ); /* NOTE: Clipper catches this at compile time! */ @@ -106,16 +155,13 @@ HARBOUR HB_MAX( void ) if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) ) { - WORD wType1 = p1->type; - WORD wType2 = p1->type; - /* NOTE: The order of these if() branches is significant, */ - /* Don't change it */ + /* Please, don't change it. */ - if( wType1 == IT_DOUBLE || wType2 == IT_DOUBLE ) + if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) ) { - double d1 = hb_parnd( 1 ); - double d2 = hb_parnd( 2 ); + double d1 = hb_itemGetND( p1 ); + double d2 = hb_itemGetND( p2 ); WORD wDec1; WORD wDec2; @@ -125,30 +171,34 @@ HARBOUR HB_MAX( void ) hb_retndlen( d1 >= d2 ? d1 : d2, 0, ( d1 >= d2 ? wDec1 : wDec2 ) ); } - else if( wType1 == IT_LONG || wType2 == IT_LONG ) + else if( IS_LONG( p1 ) || IS_LONG( p2 ) ) { - long l1 = hb_parnl( 1 ); - long l2 = hb_parnl( 2 ); + long l1 = hb_itemGetNL( p1 ); + long l2 = hb_itemGetNL( p2 ); hb_retnl( l1 >= l2 ? l1 : l2 ); } else { - int i1 = hb_parni( 1 ); - int i2 = hb_parni( 2 ); + int i1 = hb_itemGetNI( p1 ); + int i2 = hb_itemGetNI( p2 ); hb_retni( i1 >= i2 ? i1 : i2 ); } } else if( IS_DATE( p1 ) && IS_DATE( p2 ) ) - { - long l1 = p1->item.asDate.value; - long l2 = p2->item.asDate.value; + hb_retds( hb_itemGetNL( p1 ) >= hb_itemGetNL( p2 ) ? hb_pards( 1 ) : hb_pards( 2 ) ); - hb_retds( l1 >= l2 ? hb_pards( 1 ) : hb_pards( 2 ) ); - } else - hb_errRT_BASE( EG_ARG, 1093, NULL, "MAX" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1093, NULL, "MAX" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } else hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "MAX" ); /* NOTE: Clipper catches this at compile time! */ @@ -164,16 +214,13 @@ HARBOUR HB_MIN( void ) if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) ) { - WORD wType1 = p1->type; - WORD wType2 = p1->type; - /* NOTE: The order of these if() branches is significant, */ - /* Don't change it */ + /* Please, don't change it. */ - if( wType1 == IT_DOUBLE || wType2 == IT_DOUBLE ) + if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) ) { - double d1 = hb_parnd( 1 ); - double d2 = hb_parnd( 2 ); + double d1 = hb_itemGetND( p1 ); + double d2 = hb_itemGetND( p2 ); WORD wDec1; WORD wDec2; @@ -183,30 +230,34 @@ HARBOUR HB_MIN( void ) hb_retndlen( d1 <= d2 ? d1 : d2, 0, ( d1 <= d2 ? wDec1 : wDec2 ) ); } - else if( wType1 == IT_LONG || wType2 == IT_LONG ) + else if( IS_LONG( p1 ) || IS_LONG( p2 ) ) { - long l1 = hb_parnl( 1 ); - long l2 = hb_parnl( 2 ); + long l1 = hb_itemGetNL( p1 ); + long l2 = hb_itemGetNL( p2 ); hb_retnl( l1 <= l2 ? l1 : l2 ); } else { - int i1 = hb_parni( 1 ); - int i2 = hb_parni( 2 ); + int i1 = hb_itemGetNI( p1 ); + int i2 = hb_itemGetNI( p2 ); hb_retni( i1 <= i2 ? i1 : i2 ); } } else if( IS_DATE( p1 ) && IS_DATE( p2 ) ) - { - long l1 = p1->item.asDate.value; - long l2 = p2->item.asDate.value; + hb_retds( hb_itemGetNL( p1 ) <= hb_itemGetNL( p2 ) ? hb_pards( 1 ) : hb_pards( 2 ) ); - hb_retds( l1 <= l2 ? hb_pards( 1 ) : hb_pards( 2 ) ); - } else - hb_errRT_BASE( EG_ARG, 1092, NULL, "MIN" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1092, NULL, "MIN" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } else hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "MIN" ); /* NOTE: Clipper catches this at compile time! */ @@ -232,7 +283,7 @@ FUNCTION MOD(cl_num, cl_base) if( pNumber && ISNUM( 2 ) ) { - double dNumber = hb_parnd( 1 ); + double dNumber = hb_itemGetND( pNumber ); double dBase = hb_parnd( 2 ); /* dBase! Cool! */ if( dBase ) @@ -257,6 +308,9 @@ FUNCTION MOD(cl_num, cl_base) hb_errRT_BASE( EG_ARG, 1085, NULL, "%" ); } +/* DJGPP can sprintf a float that is almost 320 digits long */ +#define HB_MAX_DOUBLE_LENGTH 320 + double hb_numRound( double dResult, int iDec ) { int iSize = 64; @@ -284,7 +338,11 @@ double hb_numRound( double dResult, int iDec ) } } - szResult = ( char * ) hb_xgrab( iSize + iDec + 1 ); + /* Be paranoid and use a large amount of padding */ + /* NOTE: In Cygwin allocating a buffer with the size: iSize + iDec + 1 + often caused random GPFs. I'm not exactly sure about this, but + it seems that enlarging the buffer seemed to solve to problem. */ + szResult = ( char * ) hb_xgrab( HB_MAX_DOUBLE_LENGTH ); if( szResult ) { @@ -307,7 +365,15 @@ HARBOUR HB_ROUND( void ) hb_retndlen( hb_numRound( hb_parnd( 1 ), iDec ), 0, iDec ); } else - hb_errRT_BASE( EG_ARG, 1094, NULL, "ROUND" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1094, NULL, "ROUND" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } else hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "ROUND" ); /* NOTE: Clipper catches this at compile time! */ @@ -327,7 +393,15 @@ HARBOUR HB_SQRT( void ) hb_retnd( 0 ); /* Clipper doesn't error! */ } else - hb_errRT_BASE( EG_ARG, 1097, NULL, "SQRT" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1097, NULL, "SQRT" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } else hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "SQRT" ); /* NOTE: Clipper catches this at compile time! */ diff --git a/harbour/source/rtl/set.c b/harbour/source/rtl/set.c index 954310fa08..2908ca23eb 100644 --- a/harbour/source/rtl/set.c +++ b/harbour/source/rtl/set.c @@ -250,7 +250,7 @@ static void close_text( FHANDLE handle ) user file error value */ int user_ferror = hb_fsError(); #if ! defined(OS_UNIX_COMPATIBLE) - hb_fsWrite( handle, (BYTE *)"\x1A", 1 ); + hb_fsWrite( handle, ( BYTE * ) "\x1A", 1 ); #endif hb_fsClose( handle ); hb_fsSetError( user_ferror ); @@ -289,10 +289,10 @@ static FHANDLE open_handle( char * file_name, BOOL bAppend, char * def_ext, HB_s if( bAppend ) { /* Append mode */ - if( hb_fsFile( (BYTE *)path ) ) + if( hb_fsFile( ( BYTE * ) path ) ) { /* If the file already exists, open it (in read-write mode, in case of non-Unix and text modes). */ - handle = hb_fsOpen( (BYTE *)path, FO_READWRITE | FO_DENYWRITE ); + handle = hb_fsOpen( ( BYTE * ) path, FO_READWRITE | FO_DENYWRITE ); if( handle != FS_ERROR ) { /* Position to EOF */ #if ! defined(HB_OS_UNIX_COMPATIBLE) @@ -308,11 +308,11 @@ static FHANDLE open_handle( char * file_name, BOOL bAppend, char * def_ext, HB_s ('\x1A') character at the end (non-UNIX only). */ char cEOF = '\0'; hb_fsSeek( handle, -1, FS_END ); /* Position to last char. */ - hb_fsRead( handle, (BYTE *)&cEOF, 1 ); /* Read the last char. */ + hb_fsRead( handle, ( BYTE * ) &cEOF, 1 ); /* Read the last char. */ if( cEOF == '\x1A' ) /* If it's an EOF, */ hb_fsSeek( handle, -1, FS_END ); /* Then write over it. */ } - #endif + #endif } } else bCreate = TRUE; /* Otherwise create a new file. */ @@ -320,7 +320,7 @@ static FHANDLE open_handle( char * file_name, BOOL bAppend, char * def_ext, HB_s else bCreate = TRUE; /* Always create a new file for overwrite mode. */ if( bCreate ) - handle = hb_fsCreate( (BYTE *)path, FC_NORMAL ); + handle = hb_fsCreate( ( BYTE * ) path, FC_NORMAL ); if( handle == FS_ERROR ) { diff --git a/harbour/source/rtl/strings.c b/harbour/source/rtl/strings.c index b4958f7df7..d7d2a6b9e7 100644 --- a/harbour/source/rtl/strings.c +++ b/harbour/source/rtl/strings.c @@ -324,41 +324,43 @@ HARBOUR HB_ALLTRIM( void ) convert to unpadded string. Return pointer to string and set string length */ static char * hb_itemPadConv( PHB_ITEM pItem, char * buffer, ULONG * pulSize ) { - char * szText = NULL; + char * szText; - if( pItem ) switch( pItem->type ) + if( pItem ) { - case IT_DATE: + if( IS_STRING( pItem ) ) + { + szText = hb_itemGetCPtr( pItem ); + *pulSize = hb_itemGetCLen( pItem ); + } + else if( IS_DATE( pItem ) ) + { szText = hb_dtoc( hb_pards( 1 ), buffer, hb_set.HB_SET_DATEFORMAT ); *pulSize = strlen( szText ); - break; - - case IT_INTEGER: - sprintf( buffer, "%d", hb_parni( 1 ) ); + } + else if( IS_INTEGER( pItem ) ) + { + sprintf( buffer, "%d", hb_itemGetNI( pItem ) ); szText = buffer; *pulSize = strlen( szText ); - break; - - case IT_LONG: - sprintf( buffer, "%ld", hb_parnl( 1 ) ); + } + else if( IS_LONG( pItem ) ) + { + sprintf( buffer, "%ld", hb_itemGetNL( pItem ) ); szText = buffer; *pulSize = strlen( szText ); - break; - - case IT_DOUBLE: - if( pItem->item.asDouble.decimal ) - sprintf( buffer, "%.*f", pItem->item.asDouble.decimal, hb_parnd( 1 ) ); - else - sprintf( buffer, "%ld", hb_parnl( 1 ) ); + } + else if( IS_DOUBLE( pItem ) ) + { + sprintf( buffer, "%.*f", pItem->item.asDouble.decimal, hb_itemGetND( pItem ) ); szText = buffer; *pulSize = strlen( szText ); - break; - - case IT_STRING: - szText = hb_parc( 1 ); - *pulSize = hb_parclen( 1 ); - break; + } + else + szText = NULL; } + else + szText = NULL; return szText; } @@ -822,7 +824,15 @@ HARBOUR HB_REPLICATE( void ) hb_xfree( szResult ); } else - hb_errRT_BASE( EG_STROVERFLOW, 1234, NULL, "REPLICATE" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_STROVERFLOW, 1234, NULL, "REPLICATE" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } else hb_retc( "" ); @@ -1062,18 +1072,33 @@ HARBOUR HB_VAL( void ) if( pText ) { - int nWidth, nDec = 0; + int iWidth; + int iDec; + double dNumber = hb_strVal( pText->item.asString.value ); char * ptr = strchr( pText->item.asString.value, '.' ); if( ptr ) { - nWidth = ptr - pText->item.asString.value; - nDec = strlen( ptr + 1 ); + iWidth = ptr - pText->item.asString.value; + iDec = strlen( ptr + 1 ); } else - nWidth = strlen( pText->item.asString.value ); + { + iWidth = strlen( pText->item.asString.value ); + iDec = 0; + } - hb_retndlen( hb_strVal( pText->item.asString.value ), nWidth, nDec ); + if( iDec ) + hb_retndlen( dNumber, iWidth, iDec ); + + else if( SHRT_MIN <= dNumber && dNumber <= SHRT_MAX ) + hb_retnilen( ( int ) dNumber, iWidth ); + + else if( LONG_MIN <= dNumber && dNumber <= LONG_MAX ) + hb_retnllen( ( long ) dNumber, iWidth ); + + else + hb_retndlen( dNumber, iWidth, ( WORD ) -1 ); } else hb_errRT_BASE( EG_ARG, 1098, NULL, "VAL" ); @@ -1460,19 +1485,19 @@ HARBOUR HB_STRZERO( void ) /* Values returned : HB_STRGREATER_EQUAL, HB_STRGREATER_LEFT, HB_STRGREATER_RIGHT */ -int hb_strgreater( char * sz1, char * sz2 ) +int hb_strgreater( char * szText1, char * szText2 ) { - while( *( sz1 ) && *( sz2 ) && *( sz1 ) == *( sz2 ) ) + while( *( szText1 ) && *( szText2 ) && *( szText1 ) == *( szText2 ) ) { - sz1++; - sz2++; + szText1++; + szText2++; } - if( ( *( sz1 ) == 0 && *( sz2 ) != 0 ) || - ( *( sz2 ) > *( sz1 ) ) ) + if( ( *( szText1 ) == '\0' && *( szText2 ) != '\0' ) || + ( *( szText2 ) > *( szText1 ) ) ) return HB_STRGREATER_RIGHT; - if( ( *( sz1 ) != 0 && *( sz2 ) == 0 ) || - ( *( sz1 ) > *( sz2 ) ) ) + if( ( *( szText1 ) != '\0' && *( szText2 ) == '\0' ) || + ( *( szText1 ) > *( szText2 ) ) ) return HB_STRGREATER_LEFT; return HB_STRGREATER_EQUAL; diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 43e705fdec..2fa3524ac7 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -205,7 +205,8 @@ void hb_vmQuit( void ) void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) { BYTE bCode; - WORD w = 0, wParams; + WORD w = 0; + WORD wParams; BOOL bCanRecover = FALSE; ULONG ulPrivateBase = hb_memvarGetPrivatesBase(); @@ -421,7 +422,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) case HB_P_PARAMETER: wParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ); - hb_vmPopParameter( pSymbols + wParams, pCode[ w+3 ] ); + hb_vmPopParameter( pSymbols + wParams, pCode[ w + 3 ] ); w += 4; break; @@ -788,7 +789,16 @@ void hb_vmArrayAt( void ) else { - hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); + + if( pResult ) + { + hb_stackPop(); + hb_stackPop(); + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } + return; } @@ -916,6 +926,7 @@ void hb_vmDivide( void ) { if( IS_NUMERIC( stack.pPos - 1 ) && IS_NUMERIC( stack.pPos - 2 ) ) { + BOOL bIntegerOperands = !IS_DOUBLE( stack.pPos - 1 ) && !IS_DOUBLE( stack.pPos - 2 ); WORD wDec1, wDec2; double d2 = hb_vmPopDouble( &wDec2 ); double d1 = hb_vmPopDouble( &wDec1 ); @@ -931,7 +942,14 @@ void hb_vmDivide( void ) } } else - hb_vmPushNumber( d1 / d2, hb_set.HB_SET_DECIMALS ); + { + /* If all both operand was integer and the result is an integer, too, + push the number without decimals. Clipper compatible. */ + if( bIntegerOperands && fmod( d1, d2 ) == 0.0 ) + hb_vmPushNumber( d1 / d2, 0 ); + else + hb_vmPushNumber( d1 / d2, hb_set.HB_SET_DECIMALS ); + } } else { @@ -994,10 +1012,18 @@ void hb_vmDo( WORD wParams ) pFunc(); else { + PHB_ITEM pResult; + if( pSym->szName[ 0 ] == '_' ) - hb_errRT_BASE( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1 ); + pResult = hb_errRT_BASE_Subst( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1 ); else - hb_errRT_BASE( EG_NOMETHOD, 1004, NULL, pSym->szName ); + pResult = hb_errRT_BASE_Subst( EG_NOMETHOD, 1004, NULL, pSym->szName ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } } } else /* it is a function */ @@ -1119,12 +1145,32 @@ void hb_vmEqual( BOOL bExact ) hb_stackPop(); hb_vmOperatorCall( pItem1, pItem2, "==" ); } - else if( pItem1->type != pItem2->type ) + else if( bExact && IS_ARRAY( pItem1 ) && IS_ARRAY( pItem2 ) ) { + BOOL bResult = pItem1->item.asArray.value->pItems && pItem2->item.asArray.value->pItems && + pItem1->item.asArray.value->pItems == pItem2->item.asArray.value->pItems; + hb_stackPop(); + hb_stackPop(); + hb_vmPushLogical( bResult ); + } + else if( ( pItem1->type != pItem2->type ) || + ( IS_BLOCK( pItem1 ) && IS_BLOCK( pItem2 ) ) || + ( ! bExact && IS_ARRAY( pItem1 ) && IS_ARRAY( pItem2 ) ) ) + { + PHB_ITEM pResult; + if( bExact ) - hb_errRT_BASE( EG_ARG, 1070, NULL, "==" ); + pResult = hb_errRT_BASE_Subst( EG_ARG, 1070, NULL, "==" ); else - hb_errRT_BASE( EG_ARG, 1071, NULL, "=" ); + pResult = hb_errRT_BASE_Subst( EG_ARG, 1071, NULL, "=" ); + + if( pResult ) + { + hb_stackPop(); + hb_stackPop(); + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } } else { @@ -1245,8 +1291,7 @@ void hb_vmGreater( void ) hb_vmPushLogical( bLogical1 > bLogical2 ); } - else if( IS_OBJECT( stack.pPos - 2 ) && - hb_objHasMsg( stack.pPos - 2, ">" ) ) + else if( IS_OBJECT( stack.pPos - 2 ) && hb_objHasMsg( stack.pPos - 2, ">" ) ) { PHB_ITEM pItem2 = stack.pPos - 1; PHB_ITEM pItem1 = stack.pPos - 2; @@ -1256,7 +1301,16 @@ void hb_vmGreater( void ) } else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type ) - hb_errRT_BASE( EG_ARG, 1075, NULL, ">" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1075, NULL, ">" ); + + if( pResult ) + { + hb_stackPop(); + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } + } } void hb_vmGreaterEqual( void ) @@ -1290,8 +1344,7 @@ void hb_vmGreaterEqual( void ) hb_vmPushLogical( bLogical1 >= bLogical2 ); } - else if( IS_OBJECT( stack.pPos - 2 ) && - hb_objHasMsg( stack.pPos - 2, ">=" ) ) + else if( IS_OBJECT( stack.pPos - 2 ) && hb_objHasMsg( stack.pPos - 2, ">=" ) ) { PHB_ITEM pItem2 = stack.pPos - 1; PHB_ITEM pItem1 = stack.pPos - 2; @@ -1301,7 +1354,16 @@ void hb_vmGreaterEqual( void ) } else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type ) - hb_errRT_BASE( EG_ARG, 1076, NULL, ">=" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1076, NULL, ">=" ); + + if( pResult ) + { + hb_stackPop(); + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } + } } void hb_vmInc( void ) @@ -1386,8 +1448,7 @@ void hb_vmLess( void ) hb_vmPushLogical( bLogical1 < bLogical2 ); } - else if( IS_OBJECT( stack.pPos - 2 ) && - hb_objHasMsg( stack.pPos - 2, "<" ) ) + else if( IS_OBJECT( stack.pPos - 2 ) && hb_objHasMsg( stack.pPos - 2, "<" ) ) { PHB_ITEM pItem2 = stack.pPos - 1; PHB_ITEM pItem1 = stack.pPos - 2; @@ -1397,7 +1458,16 @@ void hb_vmLess( void ) } else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type ) - hb_errRT_BASE( EG_ARG, 1073, NULL, "<" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1073, NULL, "<" ); + + if( pResult ) + { + hb_stackPop(); + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } + } } void hb_vmLessEqual( void ) @@ -1431,8 +1501,7 @@ void hb_vmLessEqual( void ) hb_vmPushLogical( bLogical1 <= bLogical2 ); } - else if( IS_OBJECT( stack.pPos - 2 ) && - hb_objHasMsg( stack.pPos - 2, "<=" ) ) + else if( IS_OBJECT( stack.pPos - 2 ) && hb_objHasMsg( stack.pPos - 2, "<=" ) ) { PHB_ITEM pItem2 = stack.pPos - 1; PHB_ITEM pItem1 = stack.pPos - 2; @@ -1442,7 +1511,16 @@ void hb_vmLessEqual( void ) } else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type ) - hb_errRT_BASE( EG_ARG, 1074, NULL, "<=" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1074, NULL, "<=" ); + + if( pResult ) + { + hb_stackPop(); + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } + } } void hb_vmLocalName( WORD wLocal, char * szLocalName ) /* locals and parameters index and name information for the debugger */ @@ -1463,17 +1541,25 @@ void hb_vmMessage( PHB_SYMB pSymMsg ) /* sends a message to an object */ HB_DEBUG2( "Message: %s\n", pSymMsg->szName ); } +/* NOTE: Clipper is resetting the number width on a negate. */ + void hb_vmNegate( void ) { if( IS_INTEGER( stack.pPos - 1 ) ) + { ( stack.pPos - 1 )->item.asInteger.value = -( stack.pPos - 1 )->item.asInteger.value; - + ( stack.pPos - 1 )->item.asInteger.length = 10; + } else if( IS_LONG( stack.pPos - 1 ) ) + { ( stack.pPos - 1 )->item.asLong.value = -( stack.pPos - 1 )->item.asLong.value; - + ( stack.pPos - 1 )->item.asLong.length = 10; + } else if( IS_DOUBLE( stack.pPos - 1 ) ) + { ( stack.pPos - 1 )->item.asDouble.value = -( stack.pPos - 1 )->item.asDouble.value; - + ( stack.pPos - 1 )->item.asDouble.length = ( stack.pPos - 1 )->item.asDouble.value >= 10000000000.0 ? 20 : 10; + } else { PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1080, NULL, "-" ); @@ -1553,7 +1639,17 @@ void hb_vmNotEqual( void ) } else if( pItem1->type != pItem2->type ) - hb_errRT_BASE( EG_ARG, 1072, NULL, "<>" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1072, NULL, "<>" ); + + if( pResult ) + { + hb_stackPop(); + hb_stackPop(); + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } + } else { @@ -1581,7 +1677,7 @@ void hb_vmMinus( void ) long lDate2 = hb_vmPopDate(); long lDate1 = hb_vmPopDate(); - hb_vmPushNumber( lDate1 - lDate2, hb_set.HB_SET_DECIMALS ); + hb_vmPushLong( lDate1 - lDate2 ); } else if( IS_NUMERIC( pItem2 ) && IS_DATE( pItem1 ) ) { @@ -2801,16 +2897,23 @@ HARBOUR HB_LEN( void ) switch( pItem->type ) { case IT_ARRAY: - hb_retnl( hb_arrayLen( pItem ) ); - break; + hb_retnl( hb_arrayLen( pItem ) ); + break; case IT_STRING: - hb_retnl( hb_itemGetCLen( pItem ) ); - break; + hb_retnl( hb_itemGetCLen( pItem ) ); + break; default: - hb_errRT_BASE( EG_ARG, 1111, NULL, "LEN" ); - break; + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1111, NULL, "LEN" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } } else @@ -2828,41 +2931,41 @@ HARBOUR HB_EMPTY( void ) switch( pItem->type & ~IT_BYREF ) { case IT_ARRAY: - hb_retl( hb_arrayLen( pItem ) == 0 ); - break; + hb_retl( hb_arrayLen( pItem ) == 0 ); + break; case IT_STRING: - hb_retl( hb_strEmpty( hb_itemGetCPtr( pItem ), hb_itemGetCLen( pItem ) ) ); - break; + hb_retl( hb_strEmpty( hb_itemGetCPtr( pItem ), hb_itemGetCLen( pItem ) ) ); + break; case IT_INTEGER: - hb_retl( hb_itemGetNI( pItem ) == 0 ); - break; + hb_retl( hb_itemGetNI( pItem ) == 0 ); + break; case IT_LONG: - hb_retl( hb_itemGetNL( pItem ) == 0 ); - break; + hb_retl( hb_itemGetNL( pItem ) == 0 ); + break; case IT_DOUBLE: - hb_retl( hb_itemGetND( pItem ) == 0.0 ); - break; + hb_retl( hb_itemGetND( pItem ) == 0.0 ); + break; case IT_DATE: - /* NOTE: This is correct ! Get the date as long value. */ - hb_retl( hb_itemGetNL( pItem ) == 0 ); - break; + /* NOTE: This is correct ! Get the date as long value. */ + hb_retl( hb_itemGetNL( pItem ) == 0 ); + break; case IT_LOGICAL: - hb_retl( ! hb_itemGetL( pItem ) ); - break; + hb_retl( ! hb_itemGetL( pItem ) ); + break; case IT_BLOCK: - hb_retl( FALSE ); - break; + hb_retl( FALSE ); + break; default: - hb_retl( TRUE ); - break; + hb_retl( TRUE ); + break; } } else @@ -2880,35 +2983,35 @@ HARBOUR HB_VALTYPE( void ) switch( pItem->type & ~IT_BYREF ) { case IT_ARRAY: - hb_retc( hb_arrayIsObject( pItem ) ? "O" : "A" ); - break; + hb_retc( hb_arrayIsObject( pItem ) ? "O" : "A" ); + break; case IT_BLOCK: - hb_retc( "B" ); - break; + hb_retc( "B" ); + break; case IT_DATE: - hb_retc( "D" ); - break; + hb_retc( "D" ); + break; case IT_LOGICAL: - hb_retc( "L" ); - break; + hb_retc( "L" ); + break; case IT_INTEGER: case IT_LONG: case IT_DOUBLE: - hb_retc( "N" ); - break; + hb_retc( "N" ); + break; case IT_STRING: - hb_retc( "C" ); - break; + hb_retc( "C" ); + break; case IT_NIL: default: - hb_retc( "U" ); - break; + hb_retc( "U" ); + break; } } else diff --git a/harbour/tests/working/Makefile b/harbour/tests/working/Makefile index 578ff941b6..7c0d11a4dc 100644 --- a/harbour/tests/working/Makefile +++ b/harbour/tests/working/Makefile @@ -52,7 +52,6 @@ PRG_SOURCES=\ dates3.prg \ dates4.prg \ debugtst.prg \ - descend.prg \ dirtest.prg \ docase.prg \ dosshell.prg \ diff --git a/harbour/tests/working/descend.prg b/harbour/tests/working/descend.prg deleted file mode 100644 index e690f0a37a..0000000000 --- a/harbour/tests/working/descend.prg +++ /dev/null @@ -1,64 +0,0 @@ -// -// $Id$ -// - -#include "set.ch" - -function main() - - LOCAL dDate - LOCAL cString - - cString := "HARBOUR POWER & MAGIC" - OutSpec( Descend( cString ) ) - OutSpec( Descend( &cString ) ) - OutSpec( Descend( "HARBOUR POWER & MAGIC" ) ) - OutSpec( Descend( Descend( "HARBOUR POWER & MAGIC" ) ) ) - OutSpec( Descend( .f. ) ) - OutSpec( Descend( .t. ) ) - OutSpec( Descend( 1 ) ) - OutSpec( Descend( -1 ) ) - OutSpec( Descend( Descend( 256 ) ) ) - OutSpec( Descend( 2.0 ) ) - OutSpec( Descend( 2.5 ) ) - OutSpec( Descend( -100.35 ) ) - OutSpec( Descend( -740.354 ) ) - OutSpec( Descend( -740.359 ) ) - - SET( _SET_DATEFORMAT, "dd/mm/yyyy" ) - dDate := cToD( "31/12/2999" ) - OutSpec( dDate, dtos( dDate ), Descend( dDate ) ) - - dDate := cToD( "1/1/0100" ) - OutSpec( dDate, dtos( dDate ), Descend( dDate ) ) - - OutSpec( date(), dtos( date() ), Descend( date() ) ) - OutSpec( date(), dtos( date() ), Descend( Descend( date() ) ) ) - OutSpec( date()+1, dtos( date()+1 ), Descend( date()+1 ) ) - OutSpec( date()+2, dtos( date()+2 ), Descend( date()+2 ) ) - - OutSpec( Asc( Descend( "" ) ) ) - OutSpec( Descend( "" ) ) - OutSpec( Asc( Descend( chr(0) ) ) ) - OutSpec( Asc( Descend( chr(0) + "Hello" ) ) ) - OutSpec( Descend( chr(0) + "Hello" ) ) - OutSpec( Asc( Descend( "Hello" + Chr(0) + "world" ) ) ) - OutSpec( Descend( "Hello" + Chr(0) + "world" ) ) - - OutSpec( Descend( { "A", "B" } ) ) - OutSpec( ValType( Descend( { "A", "B" } ) )) - OutSpec( Descend( nil ) ) - OutSpec( ValType( Descend( nil ) )) - - OutSpec( Descend() ) - OutSpec( ValType( Descend() ) ) - -return nil - -STATIC FUNCTION OutSpec( cString ) - - OutStd( cString ) - OutStd( Chr(13) + Chr(10) ) - - RETURN NIL - diff --git a/harbour/tests/working/rtl_test.prg b/harbour/tests/working/rtl_test.prg index f7e983cec5..baa458554a 100644 --- a/harbour/tests/working/rtl_test.prg +++ b/harbour/tests/working/rtl_test.prg @@ -62,108 +62,56 @@ STATIC s_lShowAll STATIC s_lShortcut STATIC s_aSkipList +STATIC scString +STATIC scStringE +STATIC scStringZ +STATIC snIntZ +STATIC snDoubleZ +STATIC snIntP +STATIC snLongP +STATIC snDoubleP +STATIC snIntN +STATIC snLongN +STATIC snDoubleN +STATIC snDoubleI +STATIC sdDate +STATIC sdDateE +STATIC slFalse +STATIC slTrue +STATIC soObject +STATIC suNIL +STATIC sbBlock +STATIC sbBlockC +STATIC saArray +STATIC saAllTypes + +MEMVAR mxNotHere +MEMVAR mcString +MEMVAR mcStringE +MEMVAR mcStringZ +MEMVAR mnIntZ +MEMVAR mnDoubleZ +MEMVAR mnIntP +MEMVAR mnLongP +MEMVAR mnDoubleP +MEMVAR mnDoubleI +MEMVAR mnIntN +MEMVAR mnLongN +MEMVAR mnDoubleN +MEMVAR mdDate +MEMVAR mdDateE +MEMVAR mlFalse +MEMVAR mlTrue +MEMVAR moObject +MEMVAR muNIL +MEMVAR mbBlock +MEMVAR mbBlockC +MEMVAR maArray + FUNCTION Main( cPar1, cPar2 ) - /* NOTE: Some basic values we may need for some tests. - ( passing by reference, avoid preprocessor bugs, etc. ) */ - - LOCAL lcString := "HELLO" - LOCAL lcStringE := "" - LOCAL lcStringZ := "A" + Chr( 0 ) + "B" - LOCAL lnIntZ := 0 - LOCAL lnDoubleZ := 0.0 - LOCAL lnIntP := 10 - LOCAL lnLongP := 100000 - LOCAL lnDoubleP := 10.567 /* Use different number of decimals than the default */ - LOCAL lnIntN := -10 - LOCAL lnLongN := -100000 - LOCAL lnDoubleN := -10.567 /* Use different number of decimals than the default */ - LOCAL lnDoubleI := Log( 0 ) - LOCAL ldDateE := SToD( "" ) - LOCAL llFalse := .F. - LOCAL llTrue := .T. - LOCAL loObject := ErrorNew() - LOCAL luNIL := NIL - LOCAL lbBlock := {|| NIL } - LOCAL lbBlockC := {|| "(string)" } - LOCAL laArray := { 9898 } - - LOCAL laAllTypes := {; - lcString ,; - lcStringE ,; - lcStringZ ,; - lnIntZ ,; - lnDoubleZ ,; - lnIntP ,; - lnLongP ,; - lnDoubleP ,; - lnIntN ,; - lnLongN ,; - lnDoubleN ,; - lnDoubleI ,; - ldDateE ,; - llFalse ,; - llTrue ,; - loObject ,; - luNIL ,; - lbBlock ,; - lbBlockC ,; - laArray } - - MEMVAR mxNotHere - MEMVAR mcString - MEMVAR mcStringE - MEMVAR mcStringZ - MEMVAR mnIntZ - MEMVAR mnDoubleZ - MEMVAR mnIntP - MEMVAR mnLongP - MEMVAR mnDoubleP - MEMVAR mnDoubleI - MEMVAR mnIntN - MEMVAR mnLongN - MEMVAR mnDoubleN - MEMVAR mdDateE - MEMVAR mlFalse - MEMVAR mlTrue - MEMVAR moObject - MEMVAR muNIL - MEMVAR mbBlock - MEMVAR mbBlockC - MEMVAR maArray - - /* NOTE: mxNotHere intentionally not declared */ - PRIVATE mcString := "HELLO" - PRIVATE mcStringE := "" - PRIVATE mcStringZ := "A" + Chr( 0 ) + "B" - PRIVATE mnIntZ := 0 - PRIVATE mnDoubleZ := 0.0 - PRIVATE mnIntP := 10 - PRIVATE mnLongP := 100000 - PRIVATE mnDoubleP := 10.567 - PRIVATE mnIntN := -10 - PRIVATE mnLongN := -100000 - PRIVATE mnDoubleN := -10.567 - PRIVATE mnDoubleI := Log( 0 ) - PRIVATE mdDateE := SToD( "" ) - PRIVATE mlFalse := .F. - PRIVATE mlTrue := .T. - PRIVATE moObject := ErrorNew() - PRIVATE muNIL := NIL - PRIVATE mbBlock := {|| NIL } - PRIVATE mbBlockC := {|| "(string)" } - PRIVATE maArray := { 9898 } - /* Initialize test */ -/* TODO: Need to add this, when multi language support will be available - to make sure all error messages comes in the original English - language. */ -/* SET LANGID TO EN */ - SET DATE ANSI - SET CENTURY ON - SET EXACT OFF - IF cPar1 == NIL cPar1 := "" ENDIF @@ -171,54 +119,67 @@ FUNCTION Main( cPar1, cPar2 ) cPar2 := "" ENDIF + TEST_BEGIN( cPar1 + " " + cPar2 ) + + Main_HVM() + Main_MATH() + Main_STRINGS() + Main_MISC() + + /* Show results, return ERRORLEVEL and exit */ + + TEST_END() + + RETURN NIL + +STATIC FUNCTION Main_HVM() + /* NOTE: CA-Cl*pper PP fails on these TEST_LINE( "1" .AND. "2" , "E BASE 1066 Argument error conditional " ) TEST_LINE( "1" .AND. .F. , .F. ) TEST_LINE( "A" > 1 , "E BASE 1075 Argument error > F:S" ) */ - TEST_BEGIN( cPar1 + " " + cPar2 ) - /* VALTYPE() */ - TEST_LINE( ValType( lcString ) , "C" ) - TEST_LINE( ValType( lcStringE ) , "C" ) - TEST_LINE( ValType( lcStringZ ) , "C" ) - TEST_LINE( ValType( lnIntZ ) , "N" ) - TEST_LINE( ValType( lnDoubleZ ) , "N" ) - TEST_LINE( ValType( lnIntP ) , "N" ) - TEST_LINE( ValType( lnLongP ) , "N" ) - TEST_LINE( ValType( lnDoubleP ) , "N" ) - TEST_LINE( ValType( lnIntN ) , "N" ) - TEST_LINE( ValType( lnLongN ) , "N" ) - TEST_LINE( ValType( lnDoubleN ) , "N" ) - TEST_LINE( ValType( lnDoubleI ) , "N" ) - TEST_LINE( ValType( ldDateE ) , "D" ) - TEST_LINE( ValType( llFalse ) , "L" ) - TEST_LINE( ValType( llTrue ) , "L" ) - TEST_LINE( ValType( loObject ) , "O" ) - TEST_LINE( ValType( luNIL ) , "U" ) - TEST_LINE( ValType( lbBlock ) , "B" ) - TEST_LINE( ValType( laArray ) , "A" ) - TEST_LINE( ValType( @lcString ) , "U" ) - TEST_LINE( ValType( @lcStringE ) , "U" ) - TEST_LINE( ValType( @lcStringZ ) , "U" ) - TEST_LINE( ValType( @lnIntZ ) , "U" ) - TEST_LINE( ValType( @lnDoubleZ ) , "U" ) - TEST_LINE( ValType( @lnIntP ) , "U" ) - TEST_LINE( ValType( @lnLongP ) , "U" ) - TEST_LINE( ValType( @lnDoubleP ) , "U" ) - TEST_LINE( ValType( @lnIntN ) , "U" ) - TEST_LINE( ValType( @lnLongN ) , "U" ) - TEST_LINE( ValType( @lnDoubleN ) , "U" ) - TEST_LINE( ValType( @lnDoubleI ) , "U" ) - TEST_LINE( ValType( @ldDateE ) , "U" ) - TEST_LINE( ValType( @llFalse ) , "U" ) - TEST_LINE( ValType( @llTrue ) , "U" ) - TEST_LINE( ValType( @loObject ) , "U" ) - TEST_LINE( ValType( @luNIL ) , "U" ) - TEST_LINE( ValType( @lbBlock ) , "U" ) - TEST_LINE( ValType( @laArray ) , "U" ) + TEST_LINE( ValType( scString ) , "C" ) + TEST_LINE( ValType( scStringE ) , "C" ) + TEST_LINE( ValType( scStringZ ) , "C" ) + TEST_LINE( ValType( snIntZ ) , "N" ) + TEST_LINE( ValType( snDoubleZ ) , "N" ) + TEST_LINE( ValType( snIntP ) , "N" ) + TEST_LINE( ValType( snLongP ) , "N" ) + TEST_LINE( ValType( snDoubleP ) , "N" ) + TEST_LINE( ValType( snIntN ) , "N" ) + TEST_LINE( ValType( snLongN ) , "N" ) + TEST_LINE( ValType( snDoubleN ) , "N" ) + TEST_LINE( ValType( snDoubleI ) , "N" ) + TEST_LINE( ValType( sdDateE ) , "D" ) + TEST_LINE( ValType( slFalse ) , "L" ) + TEST_LINE( ValType( slTrue ) , "L" ) + TEST_LINE( ValType( soObject ) , "O" ) + TEST_LINE( ValType( suNIL ) , "U" ) + TEST_LINE( ValType( sbBlock ) , "B" ) + TEST_LINE( ValType( saArray ) , "A" ) + TEST_LINE( ValType( @scString ) , "C" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @scStringE ) , "C" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @scStringZ ) , "C" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @snIntZ ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @snDoubleZ ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @snIntP ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @snLongP ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @snDoubleP ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @snIntN ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @snLongN ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @snDoubleN ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @snDoubleI ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @sdDateE ) , "D" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @slFalse ) , "L" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @slTrue ) , "L" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @soObject ) , "O" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @suNIL ) , "U" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @sbBlock ) , "B" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @saArray ) , "A" ) /* Bug in CA-Cl*pper, it will return "U" */ TEST_LINE( ValType( mcString ) , "C" ) TEST_LINE( ValType( mcStringE ) , "C" ) TEST_LINE( ValType( mcStringZ ) , "C" ) @@ -238,25 +199,25 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( ValType( muNIL ) , "U" ) TEST_LINE( ValType( mbBlock ) , "B" ) TEST_LINE( ValType( maArray ) , "A" ) - TEST_LINE( ValType( @mcString ) , "U" ) - TEST_LINE( ValType( @mcStringE ) , "U" ) - TEST_LINE( ValType( @mcStringZ ) , "U" ) - TEST_LINE( ValType( @mnIntZ ) , "U" ) - TEST_LINE( ValType( @mnDoubleZ ) , "U" ) - TEST_LINE( ValType( @mnIntP ) , "U" ) - TEST_LINE( ValType( @mnLongP ) , "U" ) - TEST_LINE( ValType( @mnDoubleP ) , "U" ) - TEST_LINE( ValType( @mnIntN ) , "U" ) - TEST_LINE( ValType( @mnLongN ) , "U" ) - TEST_LINE( ValType( @mnDoubleN ) , "U" ) - TEST_LINE( ValType( @mnDoubleI ) , "U" ) - TEST_LINE( ValType( @mdDateE ) , "U" ) - TEST_LINE( ValType( @mlFalse ) , "U" ) - TEST_LINE( ValType( @mlTrue ) , "U" ) - TEST_LINE( ValType( @moObject ) , "U" ) - TEST_LINE( ValType( @muNIL ) , "U" ) - TEST_LINE( ValType( @mbBlock ) , "U" ) - TEST_LINE( ValType( @maArray ) , "U" ) + TEST_LINE( ValType( @mcString ) , "C" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mcStringE ) , "C" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mcStringZ ) , "C" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mnIntZ ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mnDoubleZ ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mnIntP ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mnLongP ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mnDoubleP ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mnIntN ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mnLongN ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mnDoubleN ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mnDoubleI ) , "N" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mdDateE ) , "D" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mlFalse ) , "L" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mlTrue ) , "L" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @moObject ) , "O" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @muNIL ) , "U" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @mbBlock ) , "B" ) /* Bug in CA-Cl*pper, it will return "U" */ + TEST_LINE( ValType( @maArray ) , "A" ) /* Bug in CA-Cl*pper, it will return "U" */ /* Special internal messages */ @@ -282,121 +243,26 @@ FUNCTION Main( cPar1, cPar2 ) /* Harbour compiler not yet handles these */ #ifndef __HARBOUR__ - TEST_LINE( luNIL:className , "NIL" ) + TEST_LINE( suNIL:className , "NIL" ) #endif - TEST_LINE( lcString:className , "CHARACTER" ) - TEST_LINE( lnIntP:className , "NUMERIC" ) - TEST_LINE( ldDateE:className , "DATE" ) - TEST_LINE( llFalse:className , "LOGICAL" ) - TEST_LINE( lbBlock:className , "BLOCK" ) - TEST_LINE( laArray:className , "ARRAY" ) - TEST_LINE( loObject:className , "ERROR" ) + TEST_LINE( scString:className , "CHARACTER" ) + TEST_LINE( snIntP:className , "NUMERIC" ) + TEST_LINE( sdDateE:className , "DATE" ) + TEST_LINE( slFalse:className , "LOGICAL" ) + TEST_LINE( sbBlock:className , "BLOCK" ) + TEST_LINE( saArray:className , "ARRAY" ) + TEST_LINE( soObject:className , "ERROR" ) /* Harbour compiler not yet handles these */ #ifndef __HARBOUR__ - TEST_LINE( luNIL:classH , 0 ) + TEST_LINE( suNIL:classH , 0 ) #endif - TEST_LINE( lcString:classH , 0 ) - TEST_LINE( lnIntP:classH , 0 ) - TEST_LINE( ldDateE:classH , 0 ) - TEST_LINE( llFalse:classH , 0 ) - TEST_LINE( lbBlock:classH , 0 ) - TEST_LINE( laArray:classH , 0 ) - TEST_LINE( loObject:classH > 0 , .T. ) - - /* ASCAN() */ - - TEST_LINE( aScan() , 0 ) - TEST_LINE( aScan( NIL ) , 0 ) - TEST_LINE( aScan( "A" ) , 0 ) - TEST_LINE( aScan( "A", "A" ) , 0 ) - TEST_LINE( aScan( "A", {|| .F. } ) , 0 ) - TEST_LINE( aScan( {1,2,3}, {|x| NIL } ) , 0 ) - TEST_LINE( aScan( laAllTypes, lcString ) , 1 ) - TEST_LINE( aScan( @laAllTypes, lcString ) , 0 ) - TEST_LINE( aScan( laAllTypes, @lcString ) , 0 ) - TEST_LINE( aScan( laAllTypes, lcStringE ) , 1 ) - TEST_LINE( aScan( laAllTypes, lcStringZ ) , 3 ) - TEST_LINE( aScan( laAllTypes, lnIntZ ) , 4 ) - TEST_LINE( aScan( laAllTypes, lnDoubleZ ) , 4 ) - TEST_LINE( aScan( laAllTypes, lnIntP ) , 6 ) - TEST_LINE( aScan( laAllTypes, lnLongP ) , 7 ) - TEST_LINE( aScan( laAllTypes, lnDoubleP ) , 8 ) - TEST_LINE( aScan( laAllTypes, lnIntN ) , 9 ) - TEST_LINE( aScan( laAllTypes, lnLongN ) , 10 ) - TEST_LINE( aScan( laAllTypes, lnDoubleN ) , 11 ) - TEST_LINE( aScan( laAllTypes, lnDoubleI ) , 12 ) - TEST_LINE( aScan( laAllTypes, ldDateE ) , 13 ) - TEST_LINE( aScan( laAllTypes, llFalse ) , 14 ) - TEST_LINE( aScan( laAllTypes, llTrue ) , 15 ) - TEST_LINE( aScan( laAllTypes, loObject ) , 0 ) - TEST_LINE( aScan( laAllTypes, luNIL ) , 17 ) - TEST_LINE( aScan( laAllTypes, lbBlock ) , 0 ) - TEST_LINE( aScan( laAllTypes, lbBlockC ) , 0 ) - TEST_LINE( aScan( laAllTypes, laArray ) , 0 ) - SET EXACT ON - TEST_LINE( aScan( laAllTypes, lcString ) , 1 ) - TEST_LINE( aScan( laAllTypes, lcStringE ) , 2 ) - TEST_LINE( aScan( laAllTypes, lcStringZ ) , 3 ) - SET EXACT OFF - - /* EVAL(), :EVAL */ - - TEST_LINE( Eval( NIL ) , "E BASE 1004 No exported method EVAL F:S" ) - TEST_LINE( Eval( 1 ) , "E BASE 1004 No exported method EVAL F:S" ) - TEST_LINE( Eval( @lbBlock ) , "E BASE 1004 No exported method EVAL F:S" ) - TEST_LINE( Eval( {|p1| p1 },"A","B") , "A" ) - TEST_LINE( Eval( {|p1,p2| p1+p2 },"A","B") , "AB" ) - TEST_LINE( Eval( {|p1,p2,p3| p1 },"A","B") , "A" ) -/* Harbour compiler not yet handles these */ -#ifndef __HARBOUR__ - TEST_LINE( luNIL:Eval , "E BASE 1004 No exported method EVAL F:S" ) -#endif - TEST_LINE( lcString:Eval , "E BASE 1004 No exported method EVAL F:S" ) - TEST_LINE( lnIntP:Eval , "E BASE 1004 No exported method EVAL F:S" ) - TEST_LINE( ldDateE:Eval , "E BASE 1004 No exported method EVAL F:S" ) - TEST_LINE( llFalse:Eval , "E BASE 1004 No exported method EVAL F:S" ) - TEST_LINE( lbBlock:Eval , NIL ) - TEST_LINE( laArray:Eval , "E BASE 1004 No exported method EVAL F:S" ) - TEST_LINE( loObject:Eval , "E BASE 1004 No exported method EVAL F:S" ) - - /* 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(" ") ) + TEST_LINE( scString:classH , 0 ) + TEST_LINE( snIntP:classH , 0 ) + TEST_LINE( sdDateE:classH , 0 ) + TEST_LINE( slFalse:classH , 0 ) + TEST_LINE( sbBlock:classH , 0 ) + TEST_LINE( saArray:classH , 0 ) + TEST_LINE( soObject:classH > 0 , .T. ) /* (operators) */ @@ -467,6 +333,11 @@ FUNCTION Main( cPar1, cPar2 ) #endif TEST_LINE( 1 % NIL , "E BASE 1085 Argument error % F:S" ) + TEST_LINE( -Month(sdDate) , -1 ) + TEST_LINE( Str(-(Month(sdDate))) , " -1" ) + TEST_LINE( Str(-(Val("10"))) , " -10" ) + TEST_LINE( Str(-(Val("100000"))) , " -100000" ) + TEST_LINE( Str(-(Val("20.876"))) , " -20.876" ) TEST_LINE( -(0) , 0 ) TEST_LINE( -(10) , -10 ) TEST_LINE( -(10.505) , -10.505 ) @@ -478,7 +349,7 @@ FUNCTION Main( cPar1, cPar2 ) #ifndef __HARBOUR__ TEST_LINE( "AA" $ 1 , "E BASE 1109 Argument error $ F:S" ) #endif - TEST_LINE( lcString $ 1 , "E BASE 1109 Argument error $ F:S" ) + TEST_LINE( scString $ 1 , "E BASE 1109 Argument error $ F:S" ) TEST_LINE( 1 $ "AA" , "E BASE 1109 Argument error $ F:S" ) IF TEST_OPT_Z() @@ -487,71 +358,71 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( 1 .AND. 2 , "E BASE 1066 Argument error conditional " ) TEST_LINE( NIL .AND. NIL , "E BASE 1066 Argument error conditional " ) - TEST_LINE( lcString .AND. lcString , "E BASE 1066 Argument error conditional " ) + TEST_LINE( scString .AND. scString , "E BASE 1066 Argument error conditional " ) TEST_LINE( .T. .AND. 1 , 1 ) TEST_LINE( .T. .AND. 1.567 , 1.567 ) - TEST_LINE( .T. .AND. lcString , "HELLO" ) + TEST_LINE( .T. .AND. scString , "HELLO" ) TEST_LINE( .T. .AND. SToD("") , SToD(" ") ) TEST_LINE( .T. .AND. NIL , NIL ) TEST_LINE( .T. .AND. {} , "{.[0].}" ) TEST_LINE( .T. .AND. {|| NIL } , "{||...}" ) TEST_LINE( .F. .AND. 1 , .F. ) TEST_LINE( .F. .AND. 1.567 , .F. ) - TEST_LINE( .F. .AND. lcString , .F. ) + TEST_LINE( .F. .AND. scString , .F. ) TEST_LINE( .F. .AND. SToD("") , .F. ) TEST_LINE( .F. .AND. NIL , .F. ) TEST_LINE( .F. .AND. {} , .F. ) TEST_LINE( .F. .AND. {|| NIL } , .F. ) TEST_LINE( 1 .AND. .F. , .F. ) TEST_LINE( 1.567 .AND. .F. , .F. ) - TEST_LINE( lcString .AND. .F. , .F. ) + TEST_LINE( scString .AND. .F. , .F. ) /* With the shortcut optimalization *OFF* (/z switch) */ TEST_LINE( 1 .OR. 2 , "E BASE 1066 Argument error conditional " ) TEST_LINE( .F. .OR. 2 , 2 ) TEST_LINE( .F. .OR. 1.678 , 1.678 ) - TEST_LINE( .F. .OR. lcString , "HELLO" ) + TEST_LINE( .F. .OR. scString , "HELLO" ) TEST_LINE( .T. .OR. 2 , .T. ) TEST_LINE( .T. .OR. 1.678 , .T. ) - TEST_LINE( .T. .OR. lcString , .T. ) + TEST_LINE( .T. .OR. scString , .T. ) TEST_LINE( 1 .OR. .F. , 1 ) TEST_LINE( 1.0 .OR. .F. , 1.0 ) - TEST_LINE( lcString .OR. .F. , "HELLO" ) + TEST_LINE( scString .OR. .F. , "HELLO" ) ELSE TEST_LINE( 1 .AND. 2 , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( NIL .AND. NIL , "E BASE 1078 Argument error .AND. F:S" ) - TEST_LINE( lcString .AND. lcString , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( scString .AND. scString , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( .T. .AND. 1 , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( .T. .AND. 1.567 , "E BASE 1078 Argument error .AND. F:S" ) - TEST_LINE( .T. .AND. lcString , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .T. .AND. scString , "E BASE 1078 Argument error .AND. F:S" ) 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( .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" ) + TEST_LINE( .F. .AND. scString , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( .F. .AND. SToD("") , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( .F. .AND. NIL , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( .F. .AND. {} , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( .F. .AND. {|| NIL } , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( 1 .AND. .F. , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( 1.567 .AND. .F. , "E BASE 1078 Argument error .AND. F:S" ) - TEST_LINE( lcString .AND. .F. , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( scString .AND. .F. , "E BASE 1078 Argument error .AND. F:S" ) TEST_LINE( 1 .OR. 2 , "E BASE 1079 Argument error .OR. F:S" ) TEST_LINE( .F. .OR. 2 , "E BASE 1079 Argument error .OR. F:S" ) TEST_LINE( .F. .OR. 1.678 , "E BASE 1079 Argument error .OR. F:S" ) - TEST_LINE( .F. .OR. lcString , "E BASE 1079 Argument error .OR. F:S" ) + TEST_LINE( .F. .OR. scString , "E BASE 1079 Argument error .OR. F:S" ) TEST_LINE( .T. .OR. 2 , "E BASE 1079 Argument error .OR. F:S" ) TEST_LINE( .T. .OR. 1.678 , "E BASE 1079 Argument error .OR. F:S" ) - TEST_LINE( .T. .OR. lcString , "E BASE 1079 Argument error .OR. F:S" ) + TEST_LINE( .T. .OR. scString , "E BASE 1079 Argument error .OR. F:S" ) TEST_LINE( 1 .OR. .F. , "E BASE 1079 Argument error .OR. F:S" ) TEST_LINE( 1.0 .OR. .F. , "E BASE 1079 Argument error .OR. F:S" ) - TEST_LINE( lcString .OR. .F. , "E BASE 1079 Argument error .OR. F:S" ) + TEST_LINE( scString .OR. .F. , "E BASE 1079 Argument error .OR. F:S" ) ENDIF @@ -563,33 +434,41 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( iif( .T., ":T:", ":F:" ) , ":T:" ) TEST_LINE( iif( .F., ":T:", ":F:" ) , ":F:" ) - TEST_LINE( lcString++ , "E BASE 1086 Argument error ++ F:S" ) - TEST_LINE( lcString-- , "E BASE 1087 Argument error -- F:S" ) + TEST_LINE( scString++ , "E BASE 1086 Argument error ++ F:S" ) + TEST_LINE( scString-- , "E BASE 1087 Argument error -- F:S" ) TEST_LINE( mxNotHere , "E BASE 1003 Variable does not exist MXNOTHERE F:R" ) - TEST_LINE( laArray[ 0 ] , "E BASE 1132 Bound error array access " ) - TEST_LINE( laArray[ 0 ] := 1 , "E BASE 1133 Bound error array assign " ) - TEST_LINE( laArray[ 1000 ] , "E BASE 1132 Bound error array access " ) - TEST_LINE( laArray[ 1000 ] := 1 , "E BASE 1133 Bound error array assign " ) - TEST_LINE( laArray[ -1 ] , "E BASE 1132 Bound error array access " ) - TEST_LINE( laArray[ -1 ] := 1 , "E BASE 1133 Bound error array assign " ) - TEST_LINE( laArray[ "1" ] , "E BASE 1068 Argument error array access F:S" ) - TEST_LINE( laArray[ "1" ] := 1 , "E BASE 1069 Argument error array assign " ) + TEST_LINE( saArray[ 0 ] , "E BASE 1132 Bound error array access " ) + TEST_LINE( saArray[ 0 ] := 1 , "E BASE 1133 Bound error array assign " ) + TEST_LINE( saArray[ 1000 ] , "E BASE 1132 Bound error array access " ) + TEST_LINE( saArray[ 1000 ] := 1 , "E BASE 1133 Bound error array assign " ) + TEST_LINE( saArray[ -1 ] , "E BASE 1132 Bound error array access " ) + TEST_LINE( saArray[ -1 ] := 1 , "E BASE 1133 Bound error array assign " ) + TEST_LINE( saArray[ "1" ] , "E BASE 1068 Argument error array access F:S" ) + TEST_LINE( saArray[ "1" ] := 1 , "E BASE 1069 Argument error array assign " ) - TEST_LINE( lcString > 1 , "E BASE 1075 Argument error > F:S" ) - 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 , .T. ) - TEST_LINE( loObject == ErrorNew() , .F. ) - TEST_LINE( loObject == TBColumnNew() , .F. ) - TEST_LINE( laArray == laArray , .T. ) + TEST_LINE( scString > 1 , "E BASE 1075 Argument error > F:S" ) + TEST_LINE( scString >= 1 , "E BASE 1076 Argument error >= F:S" ) + TEST_LINE( scString <> 1 , "E BASE 1072 Argument error <> F:S" ) + TEST_LINE( scString == 1 , "E BASE 1070 Argument error == F:S" ) + TEST_LINE( soObject == soObject , .T. ) + TEST_LINE( soObject = soObject , "E BASE 1071 Argument error = F:S" ) + TEST_LINE( soObject == ErrorNew() , .F. ) + TEST_LINE( soObject = ErrorNew() , "E BASE 1071 Argument error = F:S" ) + TEST_LINE( ErrorNew() == ErrorNew() , .F. ) + TEST_LINE( ErrorNew() = ErrorNew() , "E BASE 1071 Argument error = F:S" ) + TEST_LINE( soObject == TBColumnNew() , .F. ) + TEST_LINE( soObject = TBColumnNew() , "E BASE 1071 Argument error = F:S" ) + TEST_LINE( saArray == saArray , .T. ) + TEST_LINE( saArray = saArray , "E BASE 1071 Argument error = F:S" ) TEST_LINE( {} == {} , .F. ) + TEST_LINE( {} = {} , "E BASE 1071 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" ) + TEST_LINE( {|| NIL } = {|| NIL } , "E BASE 1071 Argument error = F:S" ) + TEST_LINE( scString = 1 , "E BASE 1071 Argument error = F:S" ) + TEST_LINE( scString < 1 , "E BASE 1073 Argument error < F:S" ) + TEST_LINE( scString <= 1 , "E BASE 1074 Argument error <= F:S" ) /* NOTE: TEST_CALL() should be used here, since CA-Cl*pper can't preprocess the TEST_LINE() variation properly. */ @@ -611,7 +490,9 @@ FUNCTION Main( cPar1, cPar2 ) TEST_CALL( '(.T.)->(Eof())' , {|| (.T.)->(Eof()) } , .T. ) TEST_CALL( '(.F.)->(Eof())' , {|| (.F.)->(Eof()) } , .T. ) TEST_CALL( '(NIL)->(Eof())' , {|| (NIL)->(Eof()) } , .T. ) +#ifndef __HARBOUR__ TEST_LINE( NOTHERE->NOFIELD , "E BASE 1002 Alias does not exist NOTHERE F:R" ) +#endif TEST_LINE( 200->NOFIELD , "E BASE 1003 Variable does not exist NOFIELD F:R" ) TEST_LINE( 200->("NOFIELD") , "NOFIELD" ) TEST_LINE( 200->(NIL) , NIL ) @@ -621,8 +502,8 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( 200->({|| NIL }) , "{||...}" ) TEST_LINE( 200->(.T.) , .T. ) - 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" ) + TEST_LINE( soObject:hello , "E BASE 1004 No exported method HELLO F:S" ) + TEST_LINE( soObject:hello := 1 , "E BASE 1005 No exported variable HELLO F:S" ) /* LEN() */ @@ -630,7 +511,7 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( Len( 123 ) , "E BASE 1111 Argument error LEN F:S" ) TEST_LINE( Len( "" ) , 0 ) TEST_LINE( Len( "123" ) , 3 ) - TEST_LINE( Len( laArray ) , 1 ) + TEST_LINE( Len( saArray ) , 1 ) #ifdef __HARBOUR__ TEST_LINE( Len( Space( 3000000000 ) ) , 3000000000 ) #else @@ -639,10 +520,10 @@ FUNCTION Main( cPar1, cPar2 ) /* EMPTY() */ - TEST_LINE( Empty( @lcString ) , .T. ) /* Bug in CA-Cl*pper ? */ - TEST_LINE( Empty( @lcStringE ) , .T. ) - TEST_LINE( Empty( @lnIntP ) , .T. ) /* Bug in CA-Cl*pper ? */ - TEST_LINE( Empty( @lnIntZ ) , .T. ) + TEST_LINE( Empty( @scString ) , .F. ) /* Bug in CA-Cl*pper, it will return .T. */ + TEST_LINE( Empty( @scStringE ) , .T. ) + TEST_LINE( Empty( @snIntP ) , .F. ) /* Bug in CA-Cl*pper, it will return .T. */ + TEST_LINE( Empty( @snIntZ ) , .T. ) TEST_LINE( Empty( "Hallo" ) , .F. ) TEST_LINE( Empty( "" ) , .T. ) TEST_LINE( Empty( " " ) , .T. ) @@ -674,15 +555,44 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( Empty( {0} ) , .F. ) TEST_LINE( Empty( {|x|x+x} ) , .F. ) + RETURN NIL + +STATIC FUNCTION Main_MATH() + + /* LOG() */ + + TEST_LINE( Log("A") , "E BASE 1095 Argument error LOG F:S" ) + + /* SQRT() */ + + TEST_LINE( SQrt("A") , "E BASE 1097 Argument error SQRT F:S" ) + TEST_LINE( SQrt(-1) , 0 ) + TEST_LINE( SQrt(0) , 0 ) + TEST_LINE( SQrt(4) , 2 ) + TEST_LINE( Str(SQrt(4),21,18) , " 2.000000000000000000" ) + TEST_LINE( Str(SQrt(3),21,18) , " 1.732050807568877000" ) + /* ABS() */ TEST_LINE( Abs("A") , "E BASE 1089 Argument error ABS F:S" ) TEST_LINE( Abs(0) , 0 ) TEST_LINE( Abs(10) , 10 ) TEST_LINE( Abs(-10) , 10 ) + TEST_LINE( Abs(Month(sdDate)) , 1 ) + TEST_LINE( Abs(-Month(sdDate)) , 1 ) + TEST_LINE( Str(Abs(Month(sdDate))) , " 1" ) + TEST_LINE( Str(Abs(-Month(sdDate))) , " 1" ) + TEST_LINE( Str(Abs(Val("0"))) , "0" ) + TEST_LINE( Str(Abs(Val("-0"))) , " 0" ) + TEST_LINE( Str(Abs(Val("150"))) , "150" ) + TEST_LINE( Str(Abs(Val("-150"))) , " 150" ) + TEST_LINE( Str(Abs(Val("150.245"))) , " 150.245" ) + TEST_LINE( Str(Abs(Val("-150.245"))) , " 150.245" ) TEST_LINE( Abs(0.1) , 0.1 ) TEST_LINE( Abs(10.5) , 10.5 ) TEST_LINE( Abs(-10.7) , 10.7 ) + TEST_LINE( Abs(10.578) , 10.578 ) + TEST_LINE( Abs(-10.578) , 10.578 ) TEST_LINE( Abs(100000) , 100000 ) TEST_LINE( Abs(-100000) , 100000 ) @@ -725,6 +635,110 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( Round(10.50, 0) , 11 ) TEST_LINE( Round(10.50, -1) , 10 ) + /* INT() */ + + TEST_LINE( Int( NIL ) , "E BASE 1090 Argument error INT F:S" ) + TEST_LINE( Int( "A" ) , "E BASE 1090 Argument error INT F:S" ) + TEST_LINE( Int( {} ) , "E BASE 1090 Argument error INT F:S" ) + TEST_LINE( Int( 0 ) , 0 ) + TEST_LINE( Int( 0.0 ) , 0 ) + TEST_LINE( Int( 10 ) , 10 ) + TEST_LINE( Int( -10 ) , -10 ) + TEST_LINE( Int( 100000 ) , 100000 ) + TEST_LINE( Int( -100000 ) , -100000 ) + TEST_LINE( Int( 10.5 ) , 10 ) + TEST_LINE( Int( -10.5 ) , -10 ) + TEST_LINE( Str(Int(Val("100.290"))) , "100" ) + TEST_LINE( Str(Int(Val(" 100.290"))) , " 100" ) + TEST_LINE( Str(Int(Val(" 100"))) , " 100" ) + TEST_LINE( Int(5000000000.90) , 5000000000 ) + TEST_LINE( Int(-5000000000.90) , -5000000000 ) + TEST_LINE( Int(5000000000) , 5000000000 ) + TEST_LINE( Int(-5000000000) , -5000000000 ) + TEST_LINE( Int(5000000000) / 100000 , 50000 ) + TEST_LINE( Int(-5000000000) / 100000 , -50000 ) + + /* MIN()/MAX() */ + + TEST_LINE( Max(NIL, NIL) , "E BASE 1093 Argument error MAX F:S" ) + TEST_LINE( Max(10, NIL) , "E BASE 1093 Argument error MAX F:S" ) + TEST_LINE( Max(SToD("19800101"), 10) , "E BASE 1093 Argument error MAX F:S" ) + TEST_LINE( Max(SToD("19800101"), SToD("19800101")) , SToD("19800101") ) + TEST_LINE( Max(SToD("19800102"), SToD("19800101")) , SToD("19800102") ) + TEST_LINE( Max(SToD("19800101"), SToD("19800102")) , SToD("19800102") ) + TEST_LINE( Max(snIntP, snLongP) , 100000 ) + TEST_LINE( Max(@snIntP, @snLongP) , 100000 ) /* Bug in CA-Cl*pper, it will return: "E BASE 1093 Argument error MAX F:S" */ + TEST_LINE( Min(NIL, NIL) , "E BASE 1092 Argument error MIN F:S" ) + TEST_LINE( Min(10, NIL) , "E BASE 1092 Argument error MIN F:S" ) + TEST_LINE( Min(SToD("19800101"), 10) , "E BASE 1092 Argument error MIN F:S" ) + TEST_LINE( Min(SToD("19800101"), SToD("19800101")) , SToD("19800101") ) + TEST_LINE( Min(SToD("19800102"), SToD("19800101")) , SToD("19800101") ) + TEST_LINE( Min(SToD("19800101"), SToD("19800102")) , SToD("19800101") ) + TEST_LINE( Min(snIntP, snLongP) , 10 ) + TEST_LINE( Min(@snIntP, @snLongP) , 10 ) /* Bug in CA-Cl*pper, it will return: "E BASE 1092 Argument error MIN F:S" */ + + /* 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("0") ) , "0" ) + TEST_LINE( Str(Val(" 0") ) , " 0" ) + TEST_LINE( Str(Val("-0") ) , " 0" ) + TEST_LINE( Str(Val("00") ) , " 0" ) + TEST_LINE( Str(Val("1") ) , "1" ) + TEST_LINE( Str(Val("15") ) , "15" ) + TEST_LINE( Str(Val("200") ) , "200" ) + TEST_LINE( Str(Val(" 200") ) , " 200" ) + TEST_LINE( Str(Val("200 ") ) , " 200" ) + TEST_LINE( Str(Val(" 200 ") ) , " 200" ) + TEST_LINE( Str(Val("-200") ) , "-200" ) + TEST_LINE( Str(Val(" -200") ) , " -200" ) + TEST_LINE( Str(Val("-200 ") ) , " -200" ) + 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(Val("15.000") ) , "15.000" ) + TEST_LINE( Str(Val("15.001 ") ) , "15.0010" ) + 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(100 / 13 ) , " 7.69" ) + TEST_LINE( Str(100.0 / 10 ) , " 10.00" ) + TEST_LINE( Str(100.0 / 10.00 ) , " 10.00" ) + TEST_LINE( Str(100.0 / 10.000 ) , " 10.00" ) + TEST_LINE( Str(100 / 10.00 ) , " 10.00" ) + TEST_LINE( Str(100 / 10.000 ) , " 10.00" ) + TEST_LINE( Str(100.00 / 10.0 ) , " 10.00" ) + TEST_LINE( Str(sdDate - sdDateE ) , " 2444240" ) + TEST_LINE( Str(sdDate - sdDate ) , " 0" ) + TEST_LINE( Str(1234567890 * 1234567890 ) , " 1524157875019052000" ) + + RETURN NIL + +STATIC FUNCTION Main_STRINGS() + /* AT() */ TEST_LINE( At("", "") , 1 ) @@ -832,11 +846,12 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( Pad(100000, 8) , "100000 " ) TEST_LINE( Pad(100000, 8, "-") , "100000--" ) TEST_LINE( Pad(-100000, 8, "-") , "-100000-" ) + TEST_LINE( Pad(5000000000, 15) , "5000000000 ") TEST_LINE( Pad(SToD("19800101"), 12) , "1980.01.01 " ) TEST_LINE( Pad(Year(SToD("19800101")), 5) , "1980 " ) TEST_LINE( Pad(Day(SToD("19800101")), 5) , "1 " ) - TEST_LINE( Pad(@lcString, 10) , "" ) - TEST_LINE( Pad(lcString, @lnIntP) , "" ) + TEST_LINE( Pad(@scString, 10) , "HELLO " ) /* Bug in CA-Cl*pper, it will return "" */ + TEST_LINE( Pad(scString, @snIntP) , "HELLO " ) /* Bug in CA-Cl*pper, it will return "" */ TEST_LINE( Pad("abcdef", -5) , "" ) TEST_LINE( Pad("abcdef", 0) , "" ) TEST_LINE( Pad("abcdef", 5) , "abcde" ) @@ -856,8 +871,8 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( PadR(SToD("19800101"), 12) , "1980.01.01 " ) TEST_LINE( PadR(Year(SToD("19800101")), 5) , "1980 " ) TEST_LINE( PadR(Day(SToD("19800101")), 5) , "1 " ) - TEST_LINE( PadR(@lcString, 10) , "" ) - TEST_LINE( PadR(lcString, @lnIntP) , "" ) + TEST_LINE( PadR(@scString, 10) , "HELLO " ) /* Bug in CA-Cl*pper, it will return "" */ + TEST_LINE( PadR(scString, @snIntP) , "HELLO " ) /* Bug in CA-Cl*pper, it will return "" */ TEST_LINE( PadR("abcdef", -5) , "" ) TEST_LINE( PadR("abcdef", 0) , "" ) TEST_LINE( PadR("abcdef", 5) , "abcde" ) @@ -877,8 +892,8 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( PadL(SToD("19800101"), 12) , " 1980.01.01" ) TEST_LINE( PadL(Year(SToD("19800101")), 5) , " 1980" ) TEST_LINE( PadL(Day(SToD("19800101")), 5) , " 1" ) - TEST_LINE( PadL(@lcString, 10) , "" ) - TEST_LINE( PadL(lcString, @lnIntP) , "" ) + TEST_LINE( PadL(@scString, 10) , " HELLO" ) + TEST_LINE( PadL(scString, @snIntP) , " HELLO" ) TEST_LINE( PadL("abcdef", -5) , "" ) TEST_LINE( PadL("abcdef", 0) , "" ) TEST_LINE( PadL("abcdef", 5) , "abcde" ) /* QUESTION: CA-Cl*pper "bug", should return: "bcdef" ? */ @@ -898,8 +913,8 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( PadC(SToD("19800101"), 12) , " 1980.01.01 " ) TEST_LINE( PadC(Year(SToD("19800101")), 5) , "1980 " ) TEST_LINE( PadC(Day(SToD("19800101")), 5) , " 1 " ) - TEST_LINE( PadC(@lcString, 10) , "" ) - TEST_LINE( PadC(lcString, @lnIntP) , "" ) + TEST_LINE( PadC(@scString, 10) , " HELLO " ) + TEST_LINE( PadC(scString, @snIntP) , " HELLO " ) TEST_LINE( PadC("abcdef", -5) , "" ) TEST_LINE( PadC("abcdef", 0) , "" ) TEST_LINE( PadC("abcdef", 2) , "ab" ) /* QUESTION: CA-Cl*pper "bug", should return: "cd" ? */ @@ -920,49 +935,6 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( Stuff("ABCDEF", 2, 4, "xyz") , "AxyzF" ) TEST_LINE( Stuff("ABCDEF", 2, 10, "xyz") , "Axyz" ) -#ifdef __HARBOUR__ - - /* __COLORINDEX() */ - - TEST_LINE( __ColorIndex() , "" ) - TEST_LINE( __ColorIndex("", -1) , "" ) - TEST_LINE( __ColorIndex("", 0) , "" ) - TEST_LINE( __ColorIndex("W/R", -1) , "" ) - TEST_LINE( __ColorIndex("W/R", 0) , "W/R" ) - TEST_LINE( __ColorIndex("W/R", 1) , "" ) - TEST_LINE( __ColorIndex("W/R", 2) , "" ) - TEST_LINE( __ColorIndex("W/R,GR/0", 0) , "W/R" ) - TEST_LINE( __ColorIndex("W/R,GR/0", 1) , "GR/0" ) - TEST_LINE( __ColorIndex("W/R,GR/0", 2) , "" ) - TEST_LINE( __ColorIndex("W/R,GR/0", 3) , "" ) - TEST_LINE( __ColorIndex("W/R, GR/0", 0) , "W/R" ) - TEST_LINE( __ColorIndex("W/R, GR/0", 1) , "GR/0" ) - TEST_LINE( __ColorIndex("W/R, GR/0", 2) , "" ) - TEST_LINE( __ColorIndex("W/R, GR/0", 3) , "" ) - TEST_LINE( __ColorIndex("W/R,GR/0 ", 0) , "W/R" ) - TEST_LINE( __ColorIndex("W/R,GR/0 ", 1) , "GR/0" ) - TEST_LINE( __ColorIndex("W/R,GR/0 ", 2) , "" ) - TEST_LINE( __ColorIndex("W/R, GR/0 ", 0) , "W/R" ) - TEST_LINE( __ColorIndex("W/R, GR/0 ", 1) , "GR/0" ) - TEST_LINE( __ColorIndex("W/R, GR/0 ", 2) , "" ) - TEST_LINE( __ColorIndex("W/R, GR/0 ,", 0) , "W/R" ) - TEST_LINE( __ColorIndex("W/R, GR/0 ,", 1) , "GR/0" ) - TEST_LINE( __ColorIndex("W/R, GR/0 ,", 2) , "" ) - TEST_LINE( __ColorIndex(" W/R, GR/0 ,", 0) , "W/R" ) - TEST_LINE( __ColorIndex(" W/R, GR/0 ,", 1) , "GR/0" ) - TEST_LINE( __ColorIndex(" W/R, GR/0 ,", 2) , "" ) - TEST_LINE( __ColorIndex(" W/R , GR/0 ,", 0), "W/R" ) - TEST_LINE( __ColorIndex(" W/R , GR/0 ,", 1), "GR/0" ) - TEST_LINE( __ColorIndex(" W/R , GR/0 ,", 2), "" ) - TEST_LINE( __ColorIndex(" W/R , ,", 1) , "" ) - TEST_LINE( __ColorIndex(" W/R ,,", 1) , "" ) - TEST_LINE( __ColorIndex(",,", 0) , "" ) - TEST_LINE( __ColorIndex(",,", 1) , "" ) - TEST_LINE( __ColorIndex(",,", 2) , "" ) - TEST_LINE( __ColorIndex(", ,", 2) , "" ) - -#endif - /* STR() */ TEST_LINE( Str(5000000000.0) , "5000000000.0" ) @@ -1030,61 +1002,6 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( Str(-100000, 6, -1) , "******" ) TEST_LINE( Str(-100000, 8, -1) , " -100000" ) - /* MIN()/MAX() */ - - TEST_LINE( Max(NIL, NIL) , "E BASE 1093 Argument error MAX F:S" ) - TEST_LINE( Max(10, NIL) , "E BASE 1093 Argument error MAX F:S" ) - TEST_LINE( Max(SToD("19800101"), 10) , "E BASE 1093 Argument error MAX F:S" ) - TEST_LINE( Max(SToD("19800101"), SToD("19800101")) , SToD("19800101") ) - TEST_LINE( Max(SToD("19800102"), SToD("19800101")) , SToD("19800102") ) - TEST_LINE( Max(SToD("19800101"), SToD("19800102")) , SToD("19800102") ) - TEST_LINE( Max(lnIntP, lnLongP) , 100000 ) - TEST_LINE( Max(@lnIntP, @lnLongP) , "E BASE 1093 Argument error MAX F:S" ) - TEST_LINE( Min(NIL, NIL) , "E BASE 1092 Argument error MIN F:S" ) - TEST_LINE( Min(10, NIL) , "E BASE 1092 Argument error MIN F:S" ) - TEST_LINE( Min(SToD("19800101"), 10) , "E BASE 1092 Argument error MIN F:S" ) - TEST_LINE( Min(SToD("19800101"), SToD("19800101")) , SToD("19800101") ) - TEST_LINE( Min(SToD("19800102"), SToD("19800101")) , SToD("19800101") ) - TEST_LINE( Min(SToD("19800101"), SToD("19800102")) , SToD("19800101") ) - TEST_LINE( Min(lnIntP, lnLongP) , 10 ) - TEST_LINE( Min(@lnIntP, @lnLongP) , "E BASE 1092 Argument error MIN F:S" ) - - /* 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" ) @@ -1273,15 +1190,114 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( Transform( 0 , "@BZ 9999" ) , " " ) TEST_LINE( Transform( 2334 , "Xxxxx: #####") , "Xxxxx: 2334" ) + RETURN NIL + +STATIC FUNCTION Main_MISC() + + /* ASCAN() */ + + TEST_LINE( aScan() , 0 ) + TEST_LINE( aScan( NIL ) , 0 ) + TEST_LINE( aScan( "A" ) , 0 ) + TEST_LINE( aScan( "A", "A" ) , 0 ) + TEST_LINE( aScan( "A", {|| .F. } ) , 0 ) + TEST_LINE( aScan( {1,2,3}, {|x| NIL } ) , 0 ) + TEST_LINE( aScan( saAllTypes, scString ) , 1 ) + TEST_LINE( aScan( @saAllTypes, scString ) , 1 ) /* Bug in CA-Cl*pper, it will return 0 */ + TEST_LINE( aScan( saAllTypes, @scString ) , 1 ) /* Bug in CA-Cl*pper, it will return 0 */ + TEST_LINE( aScan( saAllTypes, scStringE ) , 1 ) + TEST_LINE( aScan( saAllTypes, scStringZ ) , 3 ) + TEST_LINE( aScan( saAllTypes, snIntZ ) , 4 ) + TEST_LINE( aScan( saAllTypes, snDoubleZ ) , 4 ) + TEST_LINE( aScan( saAllTypes, snIntP ) , 6 ) + TEST_LINE( aScan( saAllTypes, snLongP ) , 7 ) + TEST_LINE( aScan( saAllTypes, snDoubleP ) , 8 ) + TEST_LINE( aScan( saAllTypes, snIntN ) , 9 ) + TEST_LINE( aScan( saAllTypes, snLongN ) , 10 ) + TEST_LINE( aScan( saAllTypes, snDoubleN ) , 11 ) + TEST_LINE( aScan( saAllTypes, snDoubleI ) , 12 ) + TEST_LINE( aScan( saAllTypes, sdDateE ) , 13 ) + TEST_LINE( aScan( saAllTypes, slFalse ) , 14 ) + TEST_LINE( aScan( saAllTypes, slTrue ) , 15 ) + TEST_LINE( aScan( saAllTypes, soObject ) , 0 ) + TEST_LINE( aScan( saAllTypes, suNIL ) , 17 ) + TEST_LINE( aScan( saAllTypes, sbBlock ) , 0 ) + TEST_LINE( aScan( saAllTypes, sbBlockC ) , 0 ) + TEST_LINE( aScan( saAllTypes, saArray ) , 0 ) + SET EXACT ON + TEST_LINE( aScan( saAllTypes, scString ) , 1 ) + TEST_LINE( aScan( saAllTypes, scStringE ) , 2 ) + TEST_LINE( aScan( saAllTypes, scStringZ ) , 3 ) + SET EXACT OFF + + /* EVAL(), :EVAL */ + + TEST_LINE( Eval( NIL ) , "E BASE 1004 No exported method EVAL F:S" ) + TEST_LINE( Eval( 1 ) , "E BASE 1004 No exported method EVAL F:S" ) + TEST_LINE( Eval( @sbBlock ) , "E BASE 1004 No exported method EVAL F:S" ) + TEST_LINE( Eval( {|p1| p1 },"A","B") , "A" ) + TEST_LINE( Eval( {|p1,p2| p1+p2 },"A","B") , "AB" ) + TEST_LINE( Eval( {|p1,p2,p3| p1 },"A","B") , "A" ) +/* Harbour compiler not yet handles these */ +#ifndef __HARBOUR__ + TEST_LINE( suNIL:Eval , "E BASE 1004 No exported method EVAL F:S" ) +#endif + TEST_LINE( scString:Eval , "E BASE 1004 No exported method EVAL F:S" ) + TEST_LINE( snIntP:Eval , "E BASE 1004 No exported method EVAL F:S" ) + TEST_LINE( sdDateE:Eval , "E BASE 1004 No exported method EVAL F:S" ) + TEST_LINE( slFalse:Eval , "E BASE 1004 No exported method EVAL F:S" ) + TEST_LINE( sbBlock:Eval , NIL ) + TEST_LINE( saArray:Eval , "E BASE 1004 No exported method EVAL F:S" ) + TEST_LINE( soObject:Eval , "E BASE 1004 No exported method EVAL F:S" ) + + /* 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 */ 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( @scString ) , "¸»´´±" ) /* Bug in CA-Cl*pper, it will return NIL */ + TEST_LINE( Descend( scString ) , "¸»´´±" ) + TEST_LINE( Descend( scString ) , "¸»´´±" ) + TEST_LINE( Descend( Descend( scString ) ) , "HELLO" ) TEST_LINE( Descend( .F. ) , .T. ) TEST_LINE( Descend( .T. ) , .F. ) TEST_LINE( Descend( 0 ) , 0.00 ) @@ -1305,9 +1321,48 @@ FUNCTION Main( cPar1, cPar2 ) TEST_LINE( Descend( SToD( "01000101" ) ) , 3474223 ) TEST_LINE( Descend( SToD( "19801220" ) ) , 2787214 ) - /* Show results, return ERRORLEVEL and exit */ +#ifdef __HARBOUR__ - TEST_END() + /* __COLORINDEX() */ + + TEST_LINE( __ColorIndex() , "" ) + TEST_LINE( __ColorIndex("", -1) , "" ) + TEST_LINE( __ColorIndex("", 0) , "" ) + TEST_LINE( __ColorIndex("W/R", -1) , "" ) + TEST_LINE( __ColorIndex("W/R", 0) , "W/R" ) + TEST_LINE( __ColorIndex("W/R", 1) , "" ) + TEST_LINE( __ColorIndex("W/R", 2) , "" ) + TEST_LINE( __ColorIndex("W/R,GR/0", 0) , "W/R" ) + TEST_LINE( __ColorIndex("W/R,GR/0", 1) , "GR/0" ) + TEST_LINE( __ColorIndex("W/R,GR/0", 2) , "" ) + TEST_LINE( __ColorIndex("W/R,GR/0", 3) , "" ) + TEST_LINE( __ColorIndex("W/R, GR/0", 0) , "W/R" ) + TEST_LINE( __ColorIndex("W/R, GR/0", 1) , "GR/0" ) + TEST_LINE( __ColorIndex("W/R, GR/0", 2) , "" ) + TEST_LINE( __ColorIndex("W/R, GR/0", 3) , "" ) + TEST_LINE( __ColorIndex("W/R,GR/0 ", 0) , "W/R" ) + TEST_LINE( __ColorIndex("W/R,GR/0 ", 1) , "GR/0" ) + TEST_LINE( __ColorIndex("W/R,GR/0 ", 2) , "" ) + TEST_LINE( __ColorIndex("W/R, GR/0 ", 0) , "W/R" ) + TEST_LINE( __ColorIndex("W/R, GR/0 ", 1) , "GR/0" ) + TEST_LINE( __ColorIndex("W/R, GR/0 ", 2) , "" ) + TEST_LINE( __ColorIndex("W/R, GR/0 ,", 0) , "W/R" ) + TEST_LINE( __ColorIndex("W/R, GR/0 ,", 1) , "GR/0" ) + TEST_LINE( __ColorIndex("W/R, GR/0 ,", 2) , "" ) + TEST_LINE( __ColorIndex(" W/R, GR/0 ,", 0) , "W/R" ) + TEST_LINE( __ColorIndex(" W/R, GR/0 ,", 1) , "GR/0" ) + TEST_LINE( __ColorIndex(" W/R, GR/0 ,", 2) , "" ) + TEST_LINE( __ColorIndex(" W/R , GR/0 ,", 0), "W/R" ) + TEST_LINE( __ColorIndex(" W/R , GR/0 ,", 1), "GR/0" ) + TEST_LINE( __ColorIndex(" W/R , GR/0 ,", 2), "" ) + TEST_LINE( __ColorIndex(" W/R , ,", 1) , "" ) + TEST_LINE( __ColorIndex(" W/R ,,", 1) , "" ) + TEST_LINE( __ColorIndex(",,", 0) , "" ) + TEST_LINE( __ColorIndex(",,", 1) , "" ) + TEST_LINE( __ColorIndex(",,", 2) , "" ) + TEST_LINE( __ColorIndex(", ,", 2) , "" ) + +#endif RETURN NIL @@ -1353,6 +1408,18 @@ STATIC FUNCTION TEST_BEGIN( cParam ) s_nPass := 0 s_nFail := 0 + /* Set up the initial state */ + +/* TODO: Need to add this, when multi language support will be available + to make sure all error messages comes in the original English + language. */ +/* SET LANGID TO EN */ + SET DATE ANSI + SET CENTURY ON + SET EXACT OFF + + /* Feedback */ + fWrite( s_nFhnd, " Version: " + Version() + s_cNewLine +; " OS: " + OS() + s_cNewLine +; " Date, Time: " + DToS( Date() ) + " " + Time() + s_cNewLine +; @@ -1368,6 +1435,76 @@ STATIC FUNCTION TEST_BEGIN( cParam ) PadR( "Expected", TEST_RESULT_COL5_WIDTH ) + s_cNewLine +; "---------------------------------------------------------------------------" + s_cNewLine ) + /* NOTE: Some basic values we may need for some tests. + ( passing by reference, avoid preprocessor bugs, etc. ) */ + + scString := "HELLO" + scStringE := "" + scStringZ := "A" + Chr( 0 ) + "B" + snIntZ := 0 + snDoubleZ := 0.0 + snIntP := 10 + snLongP := 100000 + snDoubleP := 10.567 /* Use different number of decimals than the default */ + snIntN := -10 + snLongN := -100000 + snDoubleN := -10.567 /* Use different number of decimals than the default */ + snDoubleI := Log( 0 ) + sdDate := SToD( "19800101" ) + sdDateE := SToD( "" ) + slFalse := .F. + slTrue := .T. + soObject := ErrorNew() + suNIL := NIL + sbBlock := {|| NIL } + sbBlockC := {|| "(string)" } + saArray := { 9898 } + + saAllTypes := {; + scString ,; + scStringE ,; + scStringZ ,; + snIntZ ,; + snDoubleZ ,; + snIntP ,; + snLongP ,; + snDoubleP ,; + snIntN ,; + snLongN ,; + snDoubleN ,; + snDoubleI ,; + sdDateE ,; + slFalse ,; + slTrue ,; + soObject ,; + suNIL ,; + sbBlock ,; + sbBlockC ,; + saArray } + + /* NOTE: mxNotHere intentionally not declared */ + PUBLIC mcString := "HELLO" + PUBLIC mcStringE := "" + PUBLIC mcStringZ := "A" + Chr( 0 ) + "B" + PUBLIC mnIntZ := 0 + PUBLIC mnDoubleZ := 0.0 + PUBLIC mnIntP := 10 + PUBLIC mnLongP := 100000 + PUBLIC mnDoubleP := 10.567 + PUBLIC mnIntN := -10 + PUBLIC mnLongN := -100000 + PUBLIC mnDoubleN := -10.567 + PUBLIC mnDoubleI := Log( 0 ) + PUBLIC mdDate := SToD( "19800101" ) + PUBLIC mdDateE := SToD( "" ) + PUBLIC mlFalse := .F. + PUBLIC mlTrue := .T. + PUBLIC moObject := ErrorNew() + PUBLIC muNIL := NIL + PUBLIC mbBlock := {|| NIL } + PUBLIC mbBlockC := {|| "(string)" } + PUBLIC maArray := { 9898 } + RETURN NIL STATIC FUNCTION TEST_CALL( cBlock, bBlock, xResultExpected ) diff --git a/harbour/tests/working/testdbf.prg b/harbour/tests/working/testdbf.prg index acbc42ffbb..54baff9f01 100644 --- a/harbour/tests/working/testdbf.prg +++ b/harbour/tests/working/testdbf.prg @@ -27,4 +27,10 @@ function main() ? "[" + FIELD->MEMO1 + "]" ? "[" + FIELD->MEMO2 + "]" + FIELD->NUMERIC := 90 + FIELD->DOUBLE := 120.138 + + ? "[" + Str(FIELD->DOUBLE) + "]" + ? "[" + Str(FIELD->NUMERIC) + "]" + return nil