diff --git a/harbour/ChangeLog b/harbour/ChangeLog index f6b1ac97a6..b48f201800 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,21 @@ +19990822-14:12 GMT+1 Victor Szel + * config/win32/gcc.cf + + -( -) parameters temporarly readded, to make it work, new circular + dependencies has been introduced, since HVM.C is calling RDD functions. + * include/extend.h + source/rtl/strings.c + source/rtl/math.c + * hb_mathRound() -> hb_numRound() + ! hb_numRound() fixed, so that it handles negative and zero iDec + parameter correctly. (STR()/STRZERO() got also fixed) + + Comment header added to STR() and STRZERO() + * tests/working/rtl_test.prg + * /FAIL changed to /ALL, so from now on, only the failing lines will be + showed by default. + + Added some tests. + * source/rtl/console.c + ! Comment typo fixed. + 19990822-12:49 GMT+1 Bruno Cantero * include/rddapi.h source/vm/hvm.c diff --git a/harbour/config/win32/gcc.cf b/harbour/config/win32/gcc.cf index 1b80d8d356..1871599d4c 100644 --- a/harbour/config/win32/gcc.cf +++ b/harbour/config/win32/gcc.cf @@ -28,7 +28,7 @@ endif # The -( option could be appropriate to link against libraries with # cyclic dependencies, but I think it is not really necessary if the # libraries are kept in proper order. -# LINKLIBS += -Wl,-( +LINKLIBS += -Wl,-( LINKLIBS += $(foreach lib, $(LIBS), -l$(lib)) @@ -44,7 +44,7 @@ endif # The -) option could be appropriate to link against libraries with # cyclic dependencies, but I think it is not really necessary if the # libraries are kept in proper order. -# LINKLIBS += -Wl,-) +LINKLIBS += -Wl,-) LDFLAGS = $(LINKPATHS) diff --git a/harbour/include/extend.h b/harbour/include/extend.h index 07032e48b2..751c68d92d 100644 --- a/harbour/include/extend.h +++ b/harbour/include/extend.h @@ -287,7 +287,7 @@ extern char * hb_strUpper( char * szText, ULONG ulLen ); extern char * hb_strLower( char * szText, ULONG ulLen ); extern char * hb_strDescend( char * szText, ULONG ulLen ); -extern double hb_mathRound( double dResult, int iDec ); +extern double hb_numRound( double dResult, int iDec ); /* class management */ extern void hb_clsReleaseAll( void ); /* releases all defined classes */ diff --git a/harbour/source/rtl/console.c b/harbour/source/rtl/console.c index 899aa1e78f..46b9eac83c 100644 --- a/harbour/source/rtl/console.c +++ b/harbour/source/rtl/console.c @@ -1111,7 +1111,7 @@ HARBOUR HB___ACCEPT( void ) /* Internal Clipper function used in ACCEPT command * $EXAMPLES$ * ? __ColorIndex( "W/N, N/W", CLR_ENHANCED ) // "N/W" * $TESTS$ - * see in coloring.prg for a comprehensive regression test suit. + * see in rtl_test.prg for a comprehensive regression test suit. * $STATUS$ * R * $COMPLIANCE$ diff --git a/harbour/source/rtl/math.c b/harbour/source/rtl/math.c index 7f1d9e01bc..6dccd71be1 100644 --- a/harbour/source/rtl/math.c +++ b/harbour/source/rtl/math.c @@ -241,17 +241,31 @@ FUNCTION MOD(cl_num, cl_base) } } -double hb_mathRound( double dResult, int iDec ) +double hb_numRound( double dResult, int iDec ) { int iSize = 64; char * szResult; - if( iDec < 1 ) iDec = 0; - else if( dResult != 0.0 ) + if( dResult != 0.0 ) { - double dAdjust = pow( 10, iDec ); - dResult = floor( dResult * dAdjust + 0.5 ); - dResult = dResult / dAdjust; + double dAdjust; + + if( iDec == 0 ) + { + dResult = floor( dResult + 0.5 ); + } + else if( iDec < 0 ) + { + dAdjust = pow( 10, -iDec ); + dResult = floor( dResult / dAdjust + 0.5 ); + dResult = dResult * dAdjust; + } + else + { + dAdjust = pow( 10, iDec ); + dResult = floor( dResult * dAdjust + 0.5 ); + dResult = dResult / dAdjust; + } } szResult = ( char * ) hb_xgrab( iSize + iDec + 1 ); @@ -273,7 +287,7 @@ HARBOUR HB_ROUND( void ) { int iDec = hb_parni( 2 ); - hb_retnd( hb_mathRound( hb_parnd( 1 ), iDec ) ); + hb_retnd( hb_numRound( hb_parnd( 1 ), iDec ) ); stack.Return.item.asDouble.decimal = iDec; } else diff --git a/harbour/source/rtl/strings.c b/harbour/source/rtl/strings.c index 4724909bde..abf34772f2 100644 --- a/harbour/source/rtl/strings.c +++ b/harbour/source/rtl/strings.c @@ -1243,7 +1243,7 @@ char * hb_itemStr( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec ) #endif { if( iDec < pNumber->item.asDouble.decimal ) - dNumber = hb_mathRound( dNumber, iDec ); + dNumber = hb_numRound( dNumber, iDec ); if( iDec > 0 ) iBytes = sprintf( szResult, "%*.*f", iSize, iDec, dNumber ); @@ -1277,9 +1277,75 @@ char * hb_itemStr( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec ) return( szResult ); } -/* converts a numeric to a string with optional width & precision. - calls hb_itemStr() after validating parameters -*/ + +/* $DOC$ + * $FUNCNAME$ + * STR + * $CATEGORY$ + * Run-time Library, Strings + * $ONELINER$ + * Convert a numeric expression to a character string. + * $SYNTAX$ + * STR(, [], []) --> cNumber + * $ARGUMENTS$ + * is the numeric expression to be converted to a character + * string. + * is the length of the character string to return, including + * decimal digits, decimal point, and sign. + * is the number of decimal places to return. + * $RETURNS$ + * STR() returns formatted as a character string. If the + * optional length and decimal arguments are not specified, STR() + * returns the character string according to the following rules: + * + * Results of STR() with No Optional Arguments + * --------------------------------------------------------------- + * Expression Return Value Length + * --------------------------------------------------------------- + * Field Variable Field length plus decimals + * Expressions/constants Minimum of 10 digits plus decimals + * VAL() Minimum of 3 digits + * MONTH()/DAY() 3 digits + * YEAR() 5 digits + * RECNO() 7 digits + * --------------------------------------------------------------- + * $DESCRIPTION$ + * STR() is a numeric conversion function that converts numeric values + * to character strings. It is commonly used to concatenate numeric values + * to character strings. STR() has applications displaying numbers, + * creating codes such as part numbers from numeric values, and creating + * index keys that combine numeric and character data. + * + * STR() is like TRANSFORM(), which formats numeric values as character + * strings using a mask instead of length and decimal specifications. + * + * The inverse of STR() is VAL(), which converts character numbers to + * numerics. + * + * * If is less than the number of whole number digits in + * , STR() returns asterisks instead of the number. + * + * * If is less than the number of decimal digits + * required for the decimal portion of the returned string, Harbour + * rounds the number to the available number of decimal places. + * + * * If is specified but is omitted (no + * decimal places), the return value is rounded to an integer. + * $EXAMPLES$ + * ? STR( 10, 6, 2 ) // " 10.00" + * ? STR( -10, 8, 2 ) // " -10.00" + * $TESTS$ + * see in rtl_test.prg for a comprehensive regression test suit. + * $STATUS$ + * R + * $COMPLIANCE$ + * CA-Clipper compatible. + * $SEEALSO$ + * STRZERO() + * VAL() + * $END$ + */ + HARBOUR HB_STR( void ) { if( hb_pcount() > 0 && hb_pcount() < 4 ) @@ -1330,10 +1396,78 @@ HARBOUR HB_STR( void ) } } -/* converts a numeric to a string with optional width & precision. - calls hb_itemStr() after validating parameters. - After that it pads the result with zeros. -*/ +/* ------------------------------------------------- */ +/* Copyright (C) 1999 Victor Szel */ +/* ------------------------------------------------- */ + +/* $DOC$ + * $FUNCNAME$ + * STRZERO + * $CATEGORY$ + * Run-time Library, Strings + * $ONELINER$ + * Convert a numeric expression to a character string, zero padded. + * $SYNTAX$ + * STRZERO(, [], []) --> cNumber + * $ARGUMENTS$ + * is the numeric expression to be converted to a character + * string. + * is the length of the character string to return, including + * decimal digits, decimal point, and sign. + * is the number of decimal places to return. + * $RETURNS$ + * STRZERO() returns formatted as a character string. If the + * optional length and decimal arguments are not specified, STRZERO() + * returns the character string according to the following rules: + * + * Results of STRZERO() with No Optional Arguments + * --------------------------------------------------------------- + * Expression Return Value Length + * --------------------------------------------------------------- + * Field Variable Field length plus decimals + * Expressions/constants Minimum of 10 digits plus decimals + * VAL() Minimum of 3 digits + * MONTH()/DAY() 3 digits + * YEAR() 5 digits + * RECNO() 7 digits + * --------------------------------------------------------------- + * $DESCRIPTION$ + * STRZERO() is a numeric conversion function that converts numeric values + * to character strings. It is commonly used to concatenate numeric values + * to character strings. STRZERO() has applications displaying numbers, + * creating codes such as part numbers from numeric values, and creating + * index keys that combine numeric and character data. + * + * STRZERO() is like TRANSFORM(), which formats numeric values as character + * strings using a mask instead of length and decimal specifications. + * + * The inverse of STRZERO() is VAL(), which converts character numbers to + * numerics. + * + * * If is less than the number of whole number digits in + * , STR() returns asterisks instead of the number. + * + * * If is less than the number of decimal digits + * required for the decimal portion of the returned string, Harbour + * rounds the number to the available number of decimal places. + * + * * If is specified but is omitted (no + * decimal places), the return value is rounded to an integer. + * $EXAMPLES$ + * ? STRZERO( 10, 6, 2 ) // "010.00" + * ? STRZERO( -10, 8, 2 ) // "-0010.00" + * $TESTS$ + * see in rtl_test.prg for a comprehensive regression test suit. + * $STATUS$ + * R + * $COMPLIANCE$ + * CA-Clipper compatible (it was not mentioned in the docs though). + * $SEEALSO$ + * STR() + * VAL() + * $END$ + */ + HARBOUR HB_STRZERO( void ) { if( hb_pcount() > 0 && hb_pcount() < 4 ) @@ -1375,7 +1509,8 @@ HARBOUR HB_STRZERO( void ) if ( szResult[ ulPos ] == '-' ) { - /* Negative sign found */ + /* Negative sign found, put the negative sign to the first */ + /* position */ szResult[ ulPos ] = ' '; @@ -1431,3 +1566,4 @@ int hb_strgreater( char * sz1, char * sz2 ) return HB_STRGREATER_EQUAL; } + diff --git a/harbour/tests/working/rtl_test.prg b/harbour/tests/working/rtl_test.prg index bef4fd87d9..4113a31afd 100644 --- a/harbour/tests/working/rtl_test.prg +++ b/harbour/tests/working/rtl_test.prg @@ -36,12 +36,12 @@ /* TRANSFORM() tests written by Eddie Runia */ -/* NOTE: Always compile with /n switches */ +/* NOTE: Always compile with /n switch */ /* TODO: Add checks for string parameters with embedded NUL character */ /* TODO: Add test cases for other string functions */ /* TODO: Incorporate tests from test/working/string*.prg */ -#translate TEST_LINE(, ) => TEST_CALL(<(x)>, {|| }, ) +#translate TEST_LINE( , ) => TEST_CALL(<(x)>, {|| }, ) STATIC snPass STATIC snFail @@ -49,7 +49,7 @@ STATIC scFileName STATIC snFhnd STATIC scNewLine STATIC snCount -STATIC slShowFailOnly +STATIC slShowAll FUNCTION Main( cPar1 ) @@ -86,6 +86,8 @@ FUNCTION Main( cPar1 ) 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 ) /* AT() */ @@ -532,12 +534,12 @@ STATIC FUNCTION TEST_BEGIN( cParam ) IF "OS/2" $ cOs .OR. ; "DOS" $ cOs - scNewLine := Chr(13) + Chr(10) + scNewLine := Chr( 13 ) + Chr( 10 ) ELSE - scNewLine := Chr(10) + scNewLine := Chr( 10 ) ENDIF - slShowFailOnly := "/FAIL" $ Upper( cParam ) + slShowAll := "/ALL" $ Upper( cParam ) /* #ifdef __HARBOUR__ @@ -554,40 +556,40 @@ STATIC FUNCTION TEST_BEGIN( cParam ) snPass := 0 snFail := 0 - fWrite(snFhnd, " Version: " + Version() + scNewLine +; - " OS: " + OS() + scNewLine +; - "Date, Time: " + DToS(Date()) + " " + Time() + scNewLine +; - " Output: " + scFileName + scNewLine +; - " Switches: " + cParam + scNewLine +; - "===========================================================================" + scNewLine +; - scNewLine) + fWrite( snFhnd, " Version: " + Version() + scNewLine +; + " OS: " + OS() + scNewLine +; + "Date, Time: " + DToS( Date() ) + " " + Time() + scNewLine +; + " Output: " + scFileName + scNewLine +; + " Switches: " + cParam + scNewLine +; + "===========================================================================" + scNewLine +; + scNewLine ) - fWrite(snFhnd, PadL("No", 4) + ". " +; - PadR("TestCall()", 35) + " -> " +; - PadR("Result", 15) + " | " +; - PadR("Expected", 15) +; - " [! *FAIL* !]" + scNewLine) - fWrite(snFhnd, "---------------------------------------------------------------------------" + scNewLine) + fWrite( snFhnd, PadL( "No", 4 ) + ". " +; + PadR( "TestCall()", 35 ) + " -> " +; + PadR( "Result", 15 ) + " | " +; + PadR( "Expected", 15 ) +; + " [! *FAIL* !]" + scNewLine ) + fWrite( snFhnd, "---------------------------------------------------------------------------" + scNewLine ) RETURN NIL -STATIC FUNCTION TEST_CALL(cBlock, bBlock, xResultExpected) - LOCAL xResult := Eval(bBlock) +STATIC FUNCTION TEST_CALL( cBlock, bBlock, xResultExpected ) + LOCAL xResult := Eval( bBlock ) snCount++ - IF !slShowFailOnly .OR. !( xResult == xResultExpected ) + IF slShowAll .OR. !( xResult == xResultExpected ) - fWrite(snFhnd, Str(snCount, 4) + ". " +; - PadR(StrTran(cBlock, Chr(0), "."), 35) + " -> " +; - PadR('"' + StrTran(XToStr(xResult), Chr(0), ".") + '"', 15) + " | " +; - PadR('"' + StrTran(XToStr(xResultExpected), Chr(0), ".") + '"', 15)) + fWrite( snFhnd, Str( snCount, 4 ) + ". " +; + PadR( StrTran( cBlock, Chr(0), "." ), 35 ) + " -> " +; + PadR( '"' + StrTran( XToStr( xResult ), Chr(0), "." ) + '"', 15 ) + " | " +; + PadR( '"' + StrTran( XToStr( xResultExpected ), Chr(0), "." ) + '"', 15 ) ) IF !( xResult == xResultExpected ) - fWrite(snFhnd, " ! *FAIL* !" ) + fWrite( snFhnd, " ! *FAIL* !" ) ENDIF - fWrite(snFhnd, scNewLine) + fWrite( snFhnd, scNewLine ) ENDIF IF xResult == xResultExpected @@ -600,33 +602,33 @@ STATIC FUNCTION TEST_CALL(cBlock, bBlock, xResultExpected) STATIC FUNCTION TEST_END() - fWrite(snFhnd, scNewLine +; - "===========================================================================" + scNewLine +; - "Test calls passed: " + Str(snPass) + scNewLine +; - "Test calls failed: " + Str(snFail) + scNewLine +; - scNewLine) + fWrite( snFhnd, scNewLine +; + "===========================================================================" + scNewLine +; + "Test calls passed: " + Str( snPass ) + scNewLine +; + "Test calls failed: " + Str( snFail ) + scNewLine +; + scNewLine ) IF snFail != 0 - IF "CLIPPER" $ Upper(Version()) - fWrite(snFhnd, "WARNING ! Failures detected using Clipper." + scNewLine +; - "Please fix the expected result list, if this is not a bug in Clipper itself." + scNewLine) + IF "CLIPPER" $ Upper( Version() ) + fWrite( snFhnd, "WARNING ! Failures detected using Clipper." + scNewLine +; + "Please fix the expected result list, if this is not a bug in Clipper itself." + scNewLine ) ELSE - fWrite(snFhnd, "WARNING ! Failures detected" + scNewLine) + fWrite( snFhnd, "WARNING ! Failures detected" + scNewLine ) ENDIF ENDIF - ErrorLevel(iif(snFail != 0, 1, 0)) + ErrorLevel( iif( snFail != 0, 1, 0 ) ) RETURN NIL -STATIC FUNCTION XToStr(xValue) - LOCAL cType := ValType(xValue) +STATIC FUNCTION XToStr( xValue ) + LOCAL cType := ValType( xValue ) DO CASE CASE cType == "C" ; RETURN xValue - CASE cType == "N" ; RETURN LTrim(Str(xValue)) - CASE cType == "D" ; RETURN DToC(xValue) - CASE cType == "L" ; RETURN iif(xValue, ".T.", ".F.") + CASE cType == "N" ; RETURN LTrim( Str( xValue ) ) + CASE cType == "D" ; RETURN DToC( xValue ) + CASE cType == "L" ; RETURN iif( xValue, ".T.", ".F." ) CASE cType == "O" ; RETURN xValue:className + " Object" CASE cType == "U" ; RETURN "NIL" CASE cType == "B" ; RETURN "{||...}" @@ -639,17 +641,17 @@ STATIC FUNCTION XToStr(xValue) #ifndef __HARBOUR__ #ifndef __XPP__ -FUNCTION SToD( cDate ) - LOCAL cOldDateFormat := Set(_SET_DATEFORMAT, "dd/mm/yyyy") +STATIC FUNCTION SToD( cDate ) + LOCAL cOldDateFormat := Set( _SET_DATEFORMAT, "dd/mm/yyyy" ) LOCAL dDate - Set(_SET_DATEFORMAT, "yyyy/mm/dd") + Set( _SET_DATEFORMAT, "yyyy/mm/dd" ) dDate := CToD( SubStr( cDate, 1, 4 ) + "/" +; SubStr( cDate, 5, 2 ) + "/" +; SubStr( cDate, 7, 2 ) ) - Set(_SET_DATEFORMAT, cOldDateFormat) + Set( _SET_DATEFORMAT, cOldDateFormat ) RETURN dDate