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

19990908-00:33 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-09-07 22:49:11 +00:00
parent 35cb4e4d1b
commit 5b0cd3cdab
11 changed files with 372 additions and 94 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
harbour/ChangeLog
View File

@@ -1,3 +1,45 @@
19990908-00:33 GMT+1 Victor Szel <info@szelvesz.hu>
* 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 <Culik@sl.conex.net>
19990907-17:00 GMT+1 Victor Szel <info@szelvesz.hu>
* source/vm/hvm.c
! hb_vmEqual() is now Clipper compatible for ARRAY and BLOCK types.

4
harbour/funclist.txt
View File

@@ -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;

2
harbour/include/extend.h
View File

@@ -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 )

82
harbour/source/rtl/environ.c
View File

@@ -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 <windows.h> must
be ahead of any and all #include statements! */
#if defined(_Windows) || defined(_WIN32)
#if !defined(__CYGWIN__)
#include <windows.h>
#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
{

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

@@ -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;

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

@@ -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 );

34
harbour/source/rtl/inkey.c
View File

@@ -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 */
}

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

@@ -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
{

50
harbour/source/rtl/strings.c
View File

@@ -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 );
}
}
}
}

39
harbour/source/rtl/tbcolumn.prg
View File

@@ -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

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

@@ -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