From 5b0cd3cdabc5758cf55f99ada190756f663ceee5 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Tue, 7 Sep 1999 22:49:11 +0000 Subject: [PATCH] 19990908-00:33 GMT+1 --- harbour/ChangeLog | 42 ++++++++ harbour/funclist.txt | 4 +- harbour/include/extend.h | 2 +- harbour/source/rtl/environ.c | 82 +++++++++++++--- harbour/source/rtl/extend.c | 24 ++--- harbour/source/rtl/filesys.c | 2 +- harbour/source/rtl/inkey.c | 34 +++++++ harbour/source/rtl/math.c | 39 +++----- harbour/source/rtl/strings.c | 50 ++++++---- harbour/source/rtl/tbcolumn.prg | 39 +++++--- harbour/tests/working/rtl_test.prg | 148 +++++++++++++++++++++++++++-- 11 files changed, 372 insertions(+), 94 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index e6de0431ca..00b8486192 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,45 @@ +19990908-00:33 GMT+1 Victor Szel + * source/rtl/filesys.c + % FREAD() now uses the fixed ISCHAR() macro for parameter checking, + and ISBYREF(). + * source/rtl/extend.c + ! hb_param() now checks the type mask against the dereferenced item, + until now hb_param() was not working with values passed by reference. + After this fix the IS????() macros are Clipper compatible. + * source/rtl/tbcolumn.prg + ! TBColumnNew() fixed not to throw an error when a block is not passed. + + TBColumnNew() TOFIX added about possibly different behviour than Clipper. + * source/rtl/math.c + ! hb_numRound() fixed for negative values. + % hb_numRound() is not using sprintf(), atof(), hb_x*() calls, so it should + be faster and requires less memory. All tests are still running fine. + I don't know why was it needed ? (David ?) + ! INT() fixed for values beyond -/+LONG_MAX. + ! ROUND() fixed to set the decimal width to MAX(iDec, 0) instead of iDec. + * tests/working/rtl_test.prg + + Some ROUND() tests added (mainly for negative numbers). + + Some byref tests added for several functions. + + SQRT() and some other math function tests added. + * source/rtl/strings.c + ! hb_itemStr() fixed to always use the "%*.*f" format to convert + a DOUBLE value. + ! hb_itemStr() fixed a possible error when the item.asDouble member + could accessed but the type was not DOUBLE. + + STR(), STRZERO() value substitution possible on error. + + STRZERO() added a HARBOUR_STRICT_CLIPPER_COMPATIBILIY to throw the + same error code as in Clipper, actually Clippers STRZERO will call STR + and the error will be handled by STR(), too. + * source/rtl/inkey.c + funclist.txt + tests/working/rtl_test.prg + + FKLABEL(), FKMAX() added. These are *really* dumb functions, but anyway. + Tests added. + * include/extend.h + + One cast added the IT_NUMERIC #define. + * source/rtl/environ.c + + OS(): Added Windows version detection code by + Luiz Rafael Culik + 19990907-17:00 GMT+1 Victor Szel * source/vm/hvm.c ! hb_vmEqual() is now Clipper compatible for ARRAY and BLOCK types. diff --git a/harbour/funclist.txt b/harbour/funclist.txt index 7855a38b01..90f338b3d9 100644 --- a/harbour/funclist.txt +++ b/harbour/funclist.txt @@ -118,8 +118,8 @@ FIELDPOS ;R; FIELDPUT ;R; FIELDWBLOCK ;N; FILE ;R; -FKLABEL ;N; -FKMAX ;N; +FKLABEL ;R; +FKMAX ;R; FLOCK ;R; FOPEN ;R; FOUND ;R; diff --git a/harbour/include/extend.h b/harbour/include/extend.h index ff6a2c72c4..7b8b371741 100644 --- a/harbour/include/extend.h +++ b/harbour/include/extend.h @@ -54,7 +54,7 @@ #define IT_MEMVAR ( ( WORD ) 0x4000 ) #define IT_ARRAY ( ( WORD ) 0x8000 ) #define IT_OBJECT IT_ARRAY -#define IT_NUMERIC ( IT_INTEGER | IT_LONG | IT_DOUBLE ) +#define IT_NUMERIC ( ( WORD ) ( IT_INTEGER | IT_LONG | IT_DOUBLE ) ) #define IT_ANY ( ( WORD ) 0xFFFF ) #define IS_BYREF( p ) ( ( p )->type & IT_BYREF ) diff --git a/harbour/source/rtl/environ.c b/harbour/source/rtl/environ.c index 8de47a3de0..b07e4128cf 100644 --- a/harbour/source/rtl/environ.c +++ b/harbour/source/rtl/environ.c @@ -8,13 +8,26 @@ * __RUN() */ -/* Note: The following #ifdef block for __IBMCPP__ must - be ahead of any and all #include statements! +/* NOTE: Support for determining the window version by Luiz Rafael Culik + Culik@sl.conex.net */ + +/* NOTE: The following #ifdef block for __IBMCPP__ must + be ahead of any and all #include statements! */ + #ifdef __IBMCPP__ #define INCL_DOSMISC #endif +/* NOTE: The following #ifdef block #including must + be ahead of any and all #include statements! */ + +#if defined(_Windows) || defined(_WIN32) + #if !defined(__CYGWIN__) + #include + #endif +#endif + #include "extend.h" #include "errorapi.h" #include "hbver.h" @@ -86,9 +99,44 @@ HARBOUR HB_OS( void ) /* TODO: add MSVC support but MSVC cannot detect any OS except Windows! */ #if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__MSC__) || defined(_MSC_VER) -#if defined(_Windows) || defined(_WIN32) - /* TODO: Determine the Windows type (32s/95/98/NT) and version */ - hb_os = "Windows"; +#if defined(_Windows) || defined(_WIN32) || defined(__BORLANDC__) || defined(__MSC__) || defined(_MSC_VER) && !defined(__CYGWIN__) + +/* NOTE: Support for determining the window version by Luiz Rafael Culik + Culik@sl.conex.net +*/ + + OSVERSIONINFO osVer; /* for GetVersionEx() */ + + osVer.dwOSVersionInfoSize = sizeof( osVer ); + + if( GetVersionEx( &osVer ) ) + { + switch( osVer.dwPlatformId ) + { + case VER_PLATFORM_WIN32_WINDOWS: + hb_osmajor = osVer.dwMajorVersion; + hb_osminor = osVer.dwMinorVersion; + hb_osletter = osVer.dwBuildNumber; + hb_os = "Windows 95/98"; + break; + + case VER_PLATFORM_WIN32_NT: + + hb_osmajor = osVer.dwMajorVersion; + hb_osminor = osVer.dwMinorVersion; + hb_osletter = osVer.dwBuildNumber; + hb_os = "Windows NT"; + break; + + case VER_PLATFORM_WIN32s: + hb_osmajor = osVer.dwMajorVersion; + hb_osminor = osVer.dwMinorVersion; + hb_osletter = osVer.dwBuildNumber; + hb_os = "Windows 32s"; + break; + } + } + #else #if defined(__MSC__) || defined(_MSC_VER) if( _osmode == _WIN_MODE ) @@ -99,16 +147,24 @@ HARBOUR HB_OS( void ) hb_osletter = 0; } #else - /* detect Windows */ - _AX = 0x160A; - geninterrupt( 0x2F ); - if( _AX == 0 ) - { - hb_osmajor = _BX / 256; - hb_osminor = _BX % 256; - hb_osletter = 0; + OSVERSIONINFO osVer; // for GetVersionEx() + osVer.dwOSVersionInfoSize = sizeof(osVer); + if (GetVersionEx(&osVer)) { + if (osVer.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS){ + + hb_osmajor = osVer.dwMajorVersion + hb_osminor = osVer.dwMinorVersion + hb_osletter = osVer.dwBuildNumber; hb_os = "Windows 95/98"; } + if (osVer.dwPlatformId = VER_PLATFORM_WIN32_NT){ + + hb_osmajor = osVer.dwMajorVersion + hb_osminor = osVer.dwMinorVersion + hb_osletter = osVer.dwBuildNumber; + hb_os = "Windows NT"; + } +} #endif /* __MSC__ */ else { diff --git a/harbour/source/rtl/extend.c b/harbour/source/rtl/extend.c index 98def2978c..f21c2e217a 100644 --- a/harbour/source/rtl/extend.c +++ b/harbour/source/rtl/extend.c @@ -43,27 +43,21 @@ PHB_ITEM hb_param( int iParam, WORD wMask ) { if( ( iParam >= 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) ) { + PHB_ITEM pItem; WORD wType; if( iParam == -1 ) - wType = stack.Return.type; + pItem = &stack.Return; else - wType = ( stack.pBase + 1 + iParam )->type; + pItem = stack.pBase + 1 + iParam; + + if( pItem->type & IT_BYREF ) + pItem = hb_itemUnRef( pItem ); + + wType = pItem->type; if( ( wType & wMask ) || ( wType == IT_NIL && wMask == IT_ANY ) ) - { - PHB_ITEM pLocal; - - if( iParam == -1 ) - pLocal = &stack.Return; - else - pLocal = stack.pBase + 1 + iParam; - - if( wType & IT_BYREF ) - return hb_itemUnRef( pLocal ); - else - return pLocal; - } + return pItem; } return NULL; diff --git a/harbour/source/rtl/filesys.c b/harbour/source/rtl/filesys.c index 92325c4fa6..813459c2df 100644 --- a/harbour/source/rtl/filesys.c +++ b/harbour/source/rtl/filesys.c @@ -948,7 +948,7 @@ HARBOUR HB_FREAD( void ) { ULONG ulRead = 0; - if( ISNUM( 1 ) && ( hb_parinfo( 2 ) & IT_STRING ) && ( hb_parinfo( 2 ) & IT_BYREF ) && ISNUM( 3 ) ) + if( ISNUM( 1 ) && ISCHAR( 2 ) && ISBYREF( 2 ) && ISNUM( 3 ) ) { ULONG ulToRead = hb_parnl( 3 ); diff --git a/harbour/source/rtl/inkey.c b/harbour/source/rtl/inkey.c index e7d83ea862..910e002c42 100644 --- a/harbour/source/rtl/inkey.c +++ b/harbour/source/rtl/inkey.c @@ -57,6 +57,7 @@ #include "extend.h" #include "ctoharb.h" #include "errorapi.h" +#include "itemapi.h" #include "inkey.h" #include "init.h" @@ -767,3 +768,36 @@ HARBOUR HB_LASTKEY( void ) { hb_retni( s_inkeyLast ); } + +/* Dumb function to maintain dBase III+ and CA-Cl*pper compatibility */ + +HARBOUR HB_FKLABEL( void ) +{ + PHB_ITEM pPar1 = hb_param( 1, IT_NUMERIC ); + + if( pPar1 != NULL ) + { + USHORT uiFKey = hb_itemGetNI( pPar1 ); + + if( uiFKey > 0 && uiFKey <= 40 ) + { + char szName[ 4 ]; + + sprintf( szName, "F%i", uiFKey ); + + hb_retc( szName ); + } + else + hb_retc( "" ); + } + else + hb_retc( "" ); +} + +/* Dumb function to maintain dBase III+ and CA-Cl*pper compatibility */ + +HARBOUR HB_FKMAX( void ) +{ + hb_retni( 40 ); /* IBM specific */ +} + diff --git a/harbour/source/rtl/math.c b/harbour/source/rtl/math.c index 3ac1a0a2b6..c2f445c383 100644 --- a/harbour/source/rtl/math.c +++ b/harbour/source/rtl/math.c @@ -95,11 +95,12 @@ HARBOUR HB_INT( void ) if( pNumber ) { + double dNumber = hb_itemGetND( pNumber ); WORD wWidth; hb_itemGetNLen( pNumber, &wWidth, NULL ); - hb_retndlen( ( long ) hb_parnd( 1 ), wWidth, 0 ); + hb_retndlen( dNumber >= 0 ? floor( dNumber ) : ceil( dNumber ), wWidth, 0 ); } else { @@ -308,49 +309,39 @@ 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; - char * szResult; - if( dResult != 0.0 ) { double dAdjust; if( iDec == 0 ) { - dResult = floor( dResult + 0.5 ); + if( dResult < 0.0 ) + dResult = ceil( dResult - 0.5 ); + else + dResult = floor( dResult + 0.5 ); } else if( iDec < 0 ) { dAdjust = pow( 10, -iDec ); - dResult = floor( dResult / dAdjust + 0.5 ); + if( dResult < 0.0 ) + dResult = ceil( ( dResult / dAdjust ) - 0.5 ); + else + dResult = floor( ( dResult / dAdjust ) + 0.5 ); dResult = dResult * dAdjust; } else { dAdjust = pow( 10, iDec ); - dResult = floor( dResult * dAdjust + 0.5 ); + if( dResult < 0.0 ) + dResult = ceil( ( dResult * dAdjust ) - 0.5 ); + else + dResult = floor( ( dResult * dAdjust ) + 0.5 ); dResult = dResult / dAdjust; } } - /* 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 ) - { - sprintf( szResult, "%*.*f", iSize, iDec, dResult ); - dResult = atof( szResult ); - hb_xfree( szResult ); - } - return dResult; } @@ -362,7 +353,7 @@ HARBOUR HB_ROUND( void ) { int iDec = hb_parni( 2 ); - hb_retndlen( hb_numRound( hb_parnd( 1 ), iDec ), 0, iDec ); + hb_retndlen( hb_numRound( hb_parnd( 1 ), iDec ), 0, MAX( iDec, 0 ) ); } else { diff --git a/harbour/source/rtl/strings.c b/harbour/source/rtl/strings.c index d7d2a6b9e7..fe6d97f54e 100644 --- a/harbour/source/rtl/strings.c +++ b/harbour/source/rtl/strings.c @@ -1185,13 +1185,13 @@ char * hb_itemStr( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec ) else #endif { - if( wDec < pNumber->item.asDouble.decimal ) + if( wDec < IS_DOUBLE( pNumber ) ? pNumber->item.asDouble.decimal : 0 ) dNumber = hb_numRound( dNumber, wDec ); - if( wDec > 0 ) - iBytes = sprintf( szResult, "%*.*f", iSize, wDec, dNumber ); + if( wDec == 0 ) + iBytes = sprintf( szResult, "%*.0f", iSize, dNumber ); else - iBytes = sprintf( szResult, "%*ld", wWidth, ( LONG ) dNumber ); + iBytes = sprintf( szResult, "%*.*f", iSize, wDec, dNumber ); } } else switch( pNumber->type & ~IT_BYREF ) @@ -1209,6 +1209,7 @@ char * hb_itemStr( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec ) szResult[ 0 ] = '\0'; /* null string */ break; } + /* Set to asterisks in case of overflow */ if( iBytes > iSize ) { @@ -1303,13 +1304,13 @@ HARBOUR HB_STR( void ) bValid = FALSE; else { - if( hb_pcount() > 1 ) + if( hb_pcount() >= 2 ) { pWidth = hb_param( 2, IT_NUMERIC ); if( !pWidth ) bValid = FALSE; } - if( hb_pcount() > 2 ) + if( hb_pcount() >= 3 ) { pDec = hb_param( 3, IT_NUMERIC ); if( !pDec ) @@ -1329,7 +1330,15 @@ HARBOUR HB_STR( void ) hb_retc( "" ); } else - hb_errRT_BASE( EG_ARG, 1099, NULL, "STR" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1099, NULL, "STR" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } else hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "STR" ); /* NOTE: Clipper catches this at compile time! */ @@ -1420,13 +1429,13 @@ HARBOUR HB_STRZERO( void ) bValid = FALSE; else { - if( hb_pcount() > 1 ) + if( hb_pcount() >= 2 ) { pWidth = hb_param( 2, IT_NUMERIC ); if( !pWidth ) bValid = FALSE; } - if( hb_pcount() > 2 ) + if( hb_pcount() >= 3 ) { pDec = hb_param( 3, IT_NUMERIC ); if( !pDec ) @@ -1442,9 +1451,7 @@ HARBOUR HB_STRZERO( void ) ULONG ulPos = 0; while( szResult[ ulPos ] != '\0' && szResult[ ulPos ] != '-' ) - { ulPos++; - } if( szResult[ ulPos ] == '-' ) { @@ -1455,9 +1462,7 @@ HARBOUR HB_STRZERO( void ) ulPos = 0; while( szResult[ ulPos ] != '\0' && szResult[ ulPos ] == ' ' ) - { szResult[ ulPos++ ] = '0'; - } szResult[ 0 ] = '-'; } @@ -1467,9 +1472,7 @@ HARBOUR HB_STRZERO( void ) ulPos = 0; while( szResult[ ulPos ] != '\0' && szResult[ ulPos ] == ' ' ) - { szResult[ ulPos++ ] = '0'; - } } hb_retc( szResult ); @@ -1479,7 +1482,22 @@ HARBOUR HB_STRZERO( void ) hb_retc( "" ); } else - hb_errRT_BASE( EG_ARG, 9999, NULL, "STRZERO" ); + { +#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY + /* NOTE: In CA-Cl*pper STRZERO() is writtin in Clipper, and will call + STR() to do the job, the error (if any) will also be thrown + by STR(). */ + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1099, NULL, "STR" ); +#else + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 9999, NULL, "STRZERO" ); +#endif + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } } diff --git a/harbour/source/rtl/tbcolumn.prg b/harbour/source/rtl/tbcolumn.prg index c32ecc6674..644dfa0a4a 100644 --- a/harbour/source/rtl/tbcolumn.prg +++ b/harbour/source/rtl/tbcolumn.prg @@ -51,27 +51,38 @@ METHOD New() CLASS TBColumn return Self +/* NOFIX: In Clipper the column width are not determined at this point. */ + function TBColumnNew( cHeading, bBlock ) local oCol := TBColumn():New() - loca nWidth, nType := Valtype( Eval( bBlock ) ) + local nWidth, cType - oCol:Heading = cHeading - oCol:block = bBlock - do case - case nType = "N" - nWidth = 10 + oCol:Heading := cHeading - case nType = "L" - nWidth = 3 + if ValType( bBlock ) == "B" - case nType = "C" - nWidth = Len( Eval( bBlock ) ) + oCol:block := bBlock - otherwise - nWidth = 0 - endcase - oCol:Width = If( cHeading != nil, Max( Len( cHeading ), nWidth ), nWidth ) + cType := Valtype( Eval( bBlock ) ) + + do case + case cType == "N" + nWidth := 10 + + case cType == "L" + nWidth := 3 + + case cType == "C" + nWidth := Len( Eval( bBlock ) ) + + otherwise + nWidth := 0 + endcase + + oCol:Width := If( cHeading != nil, Max( Len( cHeading ), nWidth ), nWidth ) + + endif return oCol diff --git a/harbour/tests/working/rtl_test.prg b/harbour/tests/working/rtl_test.prg index baa458554a..5eff8e37f0 100644 --- a/harbour/tests/working/rtl_test.prg +++ b/harbour/tests/working/rtl_test.prg @@ -562,15 +562,19 @@ STATIC FUNCTION Main_MATH() /* LOG() */ TEST_LINE( Log("A") , "E BASE 1095 Argument error LOG F:S" ) + TEST_LINE( Str(Log(snIntP)) , " 2.30" ) + TEST_LINE( Str(Log(@snIntP)) , " 2.30" ) /* Bug in CA-Cl*pper, it returns: "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" ) + 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(snIntP)) , " 3.16" ) + TEST_LINE( Str(Sqrt(@snIntP)) , " 3.16" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1097 Argument error SQRT F:S" */ + TEST_LINE( Str(Sqrt(4),21,18) , " 2.000000000000000000" ) + TEST_LINE( Str(Sqrt(3),21,18) , " 1.732050807568877000" ) /* ABS() */ @@ -578,12 +582,14 @@ STATIC FUNCTION Main_MATH() TEST_LINE( Abs(0) , 0 ) TEST_LINE( Abs(10) , 10 ) TEST_LINE( Abs(-10) , 10 ) + TEST_LINE( Str(Abs(snIntN)) , " 10" ) + TEST_LINE( Str(Abs(@snIntN)) , " 10" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1089 Argument error ABS F:S" */ 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("-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" ) @@ -600,6 +606,8 @@ STATIC FUNCTION Main_MATH() TEST_LINE( Exp("A") , "E BASE 1096 Argument error EXP F:S" ) TEST_LINE( Exp(0) , 1.00 ) + TEST_LINE( Str(Exp(snIntZ)) , " 1.00" ) + TEST_LINE( Str(Exp(@snIntZ)) , " 1.00" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1096 Argument error EXP F:S" */ TEST_LINE( Round(Exp(1),2) , 2.72 ) TEST_LINE( Str(Exp(1),20,10) , " 2.7182818285" ) TEST_LINE( Round(Exp(10),2) , 22026.47 ) @@ -607,6 +615,8 @@ STATIC FUNCTION Main_MATH() /* ROUND() */ + TEST_LINE( Round(snDoubleP, snIntZ) , 11 ) + TEST_LINE( Round(@snDoubleP, @snIntZ) , 11 ) /* Bug in CA-Cl*pper, it returns: "E BASE 1094 Argument error ROUND F:S" */ TEST_LINE( Round(NIL, 0) , "E BASE 1094 Argument error ROUND F:S" ) TEST_LINE( Round(0, NIL) , "E BASE 1094 Argument error ROUND F:S" ) TEST_LINE( Round(0, 0) , 0 ) @@ -627,6 +637,11 @@ STATIC FUNCTION Main_MATH() TEST_LINE( Round(0.55, 2) , 0.55 ) TEST_LINE( Round(0.55, -1) , 0 ) TEST_LINE( Round(0.55, -2) , 0 ) + TEST_LINE( Round(0.557, 0) , 1 ) + TEST_LINE( Round(0.557, 1) , 0.6 ) + TEST_LINE( Round(0.557, 2) , 0.56 ) + TEST_LINE( Round(0.557, -1) , 0 ) + TEST_LINE( Round(0.557, -2) , 0 ) TEST_LINE( Round(50, 0) , 50 ) TEST_LINE( Round(50, 1) , 50.0 ) TEST_LINE( Round(50, 2) , 50.00 ) @@ -634,6 +649,69 @@ STATIC FUNCTION Main_MATH() TEST_LINE( Round(50, -2) , 100 ) TEST_LINE( Round(10.50, 0) , 11 ) TEST_LINE( Round(10.50, -1) , 10 ) + TEST_LINE( Round(500000, 0) , 500000 ) + TEST_LINE( Round(500000, 1) , 500000.0 ) + TEST_LINE( Round(500000, 2) , 500000.00 ) + TEST_LINE( Round(500000, -1) , 500000 ) + TEST_LINE( Round(500000, -2) , 500000 ) + TEST_LINE( Round(500000, -2) , 500000 ) + TEST_LINE( Round(5000000000, 0) , 5000000000 ) + TEST_LINE( Round(5000000000, 1) , 5000000000.0 ) + TEST_LINE( Round(5000000000, 2) , 5000000000.00 ) + TEST_LINE( Round(5000000000, -1) , 5000000000 ) + TEST_LINE( Round(5000000000, -2) , 5000000000 ) + TEST_LINE( Round(5000000000, -2) , 5000000000 ) + TEST_LINE( Round(5000000000.129, 0) , 5000000000 ) + TEST_LINE( Round(5000000000.129, 1) , 5000000000.1 ) + TEST_LINE( Round(5000000000.129, 2) , 5000000000.13 ) + TEST_LINE( Round(5000000000.129, -1) , 5000000000 ) + TEST_LINE( Round(5000000000.129, -2) , 5000000000 ) + TEST_LINE( Round(5000000000.129, -2) , 5000000000 ) + TEST_LINE( Round(-0.5, 0) , -1 ) + TEST_LINE( Round(-0.5, 1) , -0.5 ) + TEST_LINE( Round(-0.5, 2) , -0.50 ) + TEST_LINE( Round(-0.5, -1) , 0 ) + TEST_LINE( Round(-0.5, -2) , 0 ) + TEST_LINE( Round(-0.50, 0) , -1 ) + TEST_LINE( Round(-0.50, 1) , -0.5 ) + TEST_LINE( Round(-0.50, 2) , -0.50 ) + TEST_LINE( Round(-0.50, -1) , 0 ) + TEST_LINE( Round(-0.50, -2) , 0 ) + TEST_LINE( Round(-0.55, 0) , -1 ) + TEST_LINE( Round(-0.55, 1) , -0.6 ) + TEST_LINE( Round(-0.55, 2) , -0.55 ) + TEST_LINE( Round(-0.55, -1) , 0 ) + TEST_LINE( Round(-0.55, -2) , 0 ) + TEST_LINE( Round(-0.557, 0) , -1 ) + TEST_LINE( Round(-0.557, 1) , -0.6 ) + TEST_LINE( Round(-0.557, 2) , -0.56 ) + TEST_LINE( Round(-0.557, -1) , 0 ) + TEST_LINE( Round(-0.557, -2) , 0 ) + TEST_LINE( Round(-50, 0) , -50 ) + TEST_LINE( Round(-50, 1) , -50.0 ) + TEST_LINE( Round(-50, 2) , -50.00 ) + TEST_LINE( Round(-50, -1) , -50 ) + TEST_LINE( Round(-50, -2) , -100 ) + TEST_LINE( Round(-10.50, 0) , -11 ) + TEST_LINE( Round(-10.50, -1) , -10 ) + TEST_LINE( Round(-500000, 0) , -500000 ) + TEST_LINE( Round(-500000, 1) , -500000.0 ) + TEST_LINE( Round(-500000, 2) , -500000.00 ) + TEST_LINE( Round(-500000, -1) , -500000 ) + TEST_LINE( Round(-500000, -2) , -500000 ) + TEST_LINE( Round(-500000, -2) , -500000 ) + TEST_LINE( Round(-5000000000, 0) , -5000000000 ) + TEST_LINE( Round(-5000000000, 1) , -5000000000.0 ) + TEST_LINE( Round(-5000000000, 2) , -5000000000.00 ) + TEST_LINE( Round(-5000000000, -1) , -5000000000 ) + TEST_LINE( Round(-5000000000, -2) , -5000000000 ) + TEST_LINE( Round(-5000000000, -2) , -5000000000 ) + TEST_LINE( Round(-5000000000.129, 0) , -5000000000 ) + TEST_LINE( Round(-5000000000.129, 1) , -5000000000.1 ) + TEST_LINE( Round(-5000000000.129, 2) , -5000000000.13 ) + TEST_LINE( Round(-5000000000.129, -1) , -5000000000 ) + TEST_LINE( Round(-5000000000.129, -2) , -5000000000 ) + TEST_LINE( Round(-5000000000.129, -2) , -5000000000 ) /* INT() */ @@ -643,6 +721,8 @@ STATIC FUNCTION Main_MATH() TEST_LINE( Int( 0 ) , 0 ) TEST_LINE( Int( 0.0 ) , 0 ) TEST_LINE( Int( 10 ) , 10 ) + TEST_LINE( Int( snIntP ) , 10 ) + TEST_LINE( Int( @snIntP ) , 10 ) /* Bug in CA-Cl*pper, it returns: "E BASE 1090 Argument error INT F:S" */ TEST_LINE( Int( -10 ) , -10 ) TEST_LINE( Int( 100000 ) , 100000 ) TEST_LINE( Int( -100000 ) , -100000 ) @@ -739,6 +819,13 @@ STATIC FUNCTION Main_MATH() STATIC FUNCTION Main_STRINGS() + /* ALLTRIM() */ + + TEST_LINE( AllTrim("HELLO") , "HELLO" ) +#ifdef __HARBOUR__ + TEST_LINE( AllTrim(@scString) , "HELLO" ) /* CA-Cl*pper bug, it will terminate the program on this line. */ +#endif + /* AT() */ TEST_LINE( At("", "") , 1 ) @@ -937,6 +1024,11 @@ STATIC FUNCTION Main_STRINGS() /* STR() */ + TEST_LINE( Str(NIL) , "E BASE 1099 Argument error STR F:S" ) + TEST_LINE( Str("A", 10, 2) , "E BASE 1099 Argument error STR F:S" ) + TEST_LINE( Str(100, 10, "A") , "E BASE 1099 Argument error STR F:S" ) + TEST_LINE( Str(100, 10, NIL) , "E BASE 1099 Argument error STR F:S" ) + TEST_LINE( Str(100, NIL, NIL) , "E BASE 1099 Argument error STR F:S" ) TEST_LINE( Str(5000000000.0) , "5000000000.0" ) TEST_LINE( Str(5000000000) , " 5000000000" ) TEST_LINE( Str(-5000000000.0) , " -5000000000.0" ) @@ -944,93 +1036,116 @@ STATIC FUNCTION Main_STRINGS() TEST_LINE( Str(10) , " 10" ) TEST_LINE( Str(10.0) , " 10.0" ) TEST_LINE( Str(10.00) , " 10.00" ) + TEST_LINE( Str(10.50) , " 10.50" ) TEST_LINE( Str(100000) , " 100000" ) TEST_LINE( Str(-10) , " -10" ) TEST_LINE( Str(-10.0) , " -10.0" ) TEST_LINE( Str(-10.00) , " -10.00" ) + TEST_LINE( Str(-10.50) , " -10.50" ) TEST_LINE( Str(-100000) , " -100000" ) TEST_LINE( Str(10, 5) , " 10" ) TEST_LINE( Str(10.0, 5) , " 10" ) TEST_LINE( Str(10.00, 5) , " 10" ) + TEST_LINE( Str(10.50, 5) , " 11" ) TEST_LINE( Str(100000, 5) , "*****" ) TEST_LINE( Str(100000, 8) , " 100000" ) TEST_LINE( Str(-10, 5) , " -10" ) TEST_LINE( Str(-10.0, 5) , " -10" ) TEST_LINE( Str(-10.00, 5) , " -10" ) + TEST_LINE( Str(-10.50, 5) , " -11" ) TEST_LINE( Str(-100000, 5) , "*****" ) TEST_LINE( Str(-100000, 6) , "******" ) TEST_LINE( Str(-100000, 8) , " -100000" ) TEST_LINE( Str(10, -5) , " 10" ) TEST_LINE( Str(10.0, -5) , " 10" ) TEST_LINE( Str(10.00, -5) , " 10" ) + TEST_LINE( Str(10.50, -5) , " 11" ) TEST_LINE( Str(100000, -5) , " 100000" ) TEST_LINE( Str(100000, -8) , " 100000" ) TEST_LINE( Str(-10, -5) , " -10" ) TEST_LINE( Str(-10.0, -5) , " -10" ) TEST_LINE( Str(-10.00, -5) , " -10" ) + TEST_LINE( Str(-10.50, -5) , " -11" ) TEST_LINE( Str(-100000, -5) , " -100000" ) TEST_LINE( Str(-100000, -6) , " -100000" ) TEST_LINE( Str(-100000, -8) , " -100000" ) TEST_LINE( Str(10, 5, 0) , " 10" ) TEST_LINE( Str(10.0, 5, 0) , " 10" ) + TEST_LINE( Str(10.00, 5, 0) , " 10" ) TEST_LINE( Str(10.50, 5, 0) , " 11" ) TEST_LINE( Str(100000, 5, 0) , "*****" ) TEST_LINE( Str(-10, 5, 0) , " -10" ) TEST_LINE( Str(-10.0, 5, 0) , " -10" ) TEST_LINE( Str(-10.00, 5, 0) , " -10" ) + TEST_LINE( Str(-10.50, 5, 0) , " -11" ) TEST_LINE( Str(-100000, 5, 0) , "*****" ) TEST_LINE( Str(-100000, 6, 0) , "******" ) TEST_LINE( Str(-100000, 8, 0) , " -100000" ) TEST_LINE( Str(10, 5, 1) , " 10.0" ) TEST_LINE( Str(10.0, 5, 1) , " 10.0" ) + TEST_LINE( Str(10.00, 5, 1) , " 10.0" ) TEST_LINE( Str(10.50, 5, 1) , " 10.5" ) TEST_LINE( Str(100000, 5, 1) , "*****" ) TEST_LINE( Str(-10, 5, 1) , "-10.0" ) TEST_LINE( Str(-10.0, 5, 1) , "-10.0" ) TEST_LINE( Str(-10.00, 5, 1) , "-10.0" ) + TEST_LINE( Str(-10.50, 5, 1) , "-10.5" ) TEST_LINE( Str(-100000, 5, 1) , "*****" ) TEST_LINE( Str(-100000, 6, 1) , "******" ) TEST_LINE( Str(-100000, 8, 1) , "********" ) TEST_LINE( Str(10, 5, -1) , " 10" ) TEST_LINE( Str(10.0, 5, -1) , " 10" ) + TEST_LINE( Str(10.00, 5, -1) , " 10" ) TEST_LINE( Str(10.50, 5, -1) , " 11" ) TEST_LINE( Str(100000, 5, -1) , "*****" ) TEST_LINE( Str(-10, 5, -1) , " -10" ) TEST_LINE( Str(-10.0, 5, -1) , " -10" ) TEST_LINE( Str(-10.00, 5, -1) , " -10" ) + TEST_LINE( Str(-10.50, 5, -1) , " -11" ) TEST_LINE( Str(-100000, 5, -1) , "*****" ) TEST_LINE( Str(-100000, 6, -1) , "******" ) TEST_LINE( Str(-100000, 8, -1) , " -100000" ) /* STRZERO() */ + TEST_LINE( StrZero(NIL) , "E BASE 1099 Argument error STR F:S" ) + TEST_LINE( StrZero("A", 10, 2) , "E BASE 1099 Argument error STR F:S" ) + TEST_LINE( StrZero(100, 10, "A") , "E BASE 1099 Argument error STR F:S" ) + TEST_LINE( StrZero(100, 10, NIL) , "E BASE 1099 Argument error STR F:S" ) + TEST_LINE( StrZero(100, NIL, NIL) , "E BASE 1099 Argument error STR F:S" ) TEST_LINE( StrZero(10) , "0000000010" ) TEST_LINE( StrZero(10.0) , "0000000010.0" ) TEST_LINE( StrZero(10.00) , "0000000010.00" ) + TEST_LINE( StrZero(10.50) , "0000000010.50" ) TEST_LINE( StrZero(100000) , "0000100000" ) TEST_LINE( StrZero(-10) , "-000000010" ) TEST_LINE( StrZero(-10.0) , "-000000010.0" ) TEST_LINE( StrZero(-10.00) , "-000000010.00" ) + TEST_LINE( StrZero(-10.50) , "-000000010.50" ) TEST_LINE( StrZero(-100000) , "-000100000" ) TEST_LINE( StrZero(10, 5) , "00010" ) TEST_LINE( StrZero(10.0, 5) , "00010" ) TEST_LINE( StrZero(10.00, 5) , "00010" ) + TEST_LINE( StrZero(10.50, 5) , "00011" ) TEST_LINE( StrZero(100000, 5) , "*****" ) TEST_LINE( StrZero(100000, 8) , "00100000" ) TEST_LINE( StrZero(-10, 5) , "-0010" ) TEST_LINE( StrZero(-10.0, 5) , "-0010" ) TEST_LINE( StrZero(-10.00, 5) , "-0010" ) + TEST_LINE( StrZero(-10.50, 5) , "-0011" ) TEST_LINE( StrZero(-100000, 5) , "*****" ) TEST_LINE( StrZero(-100000, 6) , "******" ) TEST_LINE( StrZero(-100000, 8) , "-0100000" ) TEST_LINE( StrZero(10, -5) , "0000000010" ) TEST_LINE( StrZero(10.0, -5) , "0000000010" ) TEST_LINE( StrZero(10.00, -5) , "0000000010" ) + TEST_LINE( StrZero(10.50, -5) , "0000000011" ) TEST_LINE( StrZero(100000, -5) , "0000100000" ) TEST_LINE( StrZero(100000, -8) , "0000100000" ) TEST_LINE( StrZero(-10, -5) , "-000000010" ) TEST_LINE( StrZero(-10.0, -5) , "-000000010" ) TEST_LINE( StrZero(-10.00, -5) , "-000000010" ) + TEST_LINE( StrZero(-10.50, -5) , "-000000011" ) TEST_LINE( StrZero(-100000, -5) , "-000100000" ) TEST_LINE( StrZero(-100000, -6) , "-000100000" ) TEST_LINE( StrZero(-100000, -8) , "-000100000" ) @@ -1041,6 +1156,7 @@ STATIC FUNCTION Main_STRINGS() TEST_LINE( StrZero(-10, 5, 0) , "-0010" ) TEST_LINE( StrZero(-10.0, 5, 0) , "-0010" ) TEST_LINE( StrZero(-10.00, 5, 0) , "-0010" ) + TEST_LINE( StrZero(-10.50, 5, 0) , "-0011" ) TEST_LINE( StrZero(-100000, 5, 0) , "*****" ) TEST_LINE( StrZero(-100000, 6, 0) , "******" ) TEST_LINE( StrZero(-100000, 8, 0) , "-0100000" ) @@ -1051,6 +1167,7 @@ STATIC FUNCTION Main_STRINGS() TEST_LINE( StrZero(-10, 5, 1) , "-10.0" ) TEST_LINE( StrZero(-10.0, 5, 1) , "-10.0" ) TEST_LINE( StrZero(-10.00, 5, 1) , "-10.0" ) + TEST_LINE( StrZero(-10.50, 5, 1) , "-10.5" ) TEST_LINE( StrZero(-100000, 5, 1) , "*****" ) TEST_LINE( StrZero(-100000, 6, 1) , "******" ) TEST_LINE( StrZero(-100000, 8, 1) , "********" ) @@ -1061,6 +1178,7 @@ STATIC FUNCTION Main_STRINGS() TEST_LINE( StrZero(-10, 5, -1) , "-0010" ) TEST_LINE( StrZero(-10.0, 5, -1) , "-0010" ) TEST_LINE( StrZero(-10.00, 5, -1) , "-0010" ) + TEST_LINE( StrZero(-10.50, 5, -1) , "-0011" ) TEST_LINE( StrZero(-100000, 5, -1) , "*****" ) TEST_LINE( StrZero(-100000, 6, -1) , "******" ) TEST_LINE( StrZero(-100000, 8, -1) , "-0100000" ) @@ -1234,7 +1352,7 @@ STATIC FUNCTION Main_MISC() 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( @sbBlock ) , NIL ) /* Bug in CA-Cl*pper, it will return: "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" ) @@ -1364,6 +1482,20 @@ STATIC FUNCTION Main_MISC() #endif + /* FKMAX(), FKLABEL() */ + + TEST_LINE( FKMax() , 40 ) + TEST_LINE( FKMax( 1 ) , 40 ) + TEST_LINE( FKLabel() , "" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1074 Argument error <= F:S" */ + TEST_LINE( FKLabel( NIL ) , "" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1074 Argument error <= F:S" */ + TEST_LINE( FKLabel( "A" ) , "" ) /* Bug in CA-Cl*pper, it returns: "E BASE 1074 Argument error <= F:S" */ + TEST_LINE( FKLabel( -1 ) , "" ) + TEST_LINE( FKLabel( 0 ) , "" ) + TEST_LINE( FKLabel( 1 ) , "F1" ) + TEST_LINE( FKLabel( 25 ) , "F25" ) + TEST_LINE( FKLabel( 40 ) , "F40" ) + TEST_LINE( FKLabel( 41 ) , "" ) + RETURN NIL #define TEST_RESULT_COL1_WIDTH 1