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

19990822-14:12 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-08-22 12:26:54 +00:00
parent 64d6e54bc6
commit 5564e48ae6
7 changed files with 237 additions and 67 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
harbour/ChangeLog
View File

@@ -1,3 +1,21 @@
19990822-14:12 GMT+1 Victor Szel <info@szelvesz.hu>
* 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 <bruno@issnet.net>
* include/rddapi.h
source/vm/hvm.c

4
harbour/config/win32/gcc.cf
View File

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

2
harbour/include/extend.h
View File

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

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

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

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

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

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

@@ -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(<nNumber>, [<nLength>], [<nDecimals>]) --> cNumber
* $ARGUMENTS$
* <nNumber> is the numeric expression to be converted to a character
* string.
* <nLength> is the length of the character string to return, including
* decimal digits, decimal point, and sign.
* <nDecimals> is the number of decimal places to return.
* $RETURNS$
* STR() returns <nNumber> 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 <nLength> is less than the number of whole number digits in
* <nNumber>, STR() returns asterisks instead of the number.
*
* * If <nLength> 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 <nLength> is specified but <nDecimals> 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 <info@szelvesz.hu> */
/* ------------------------------------------------- */
/* $DOC$
* $FUNCNAME$
* STRZERO
* $CATEGORY$
* Run-time Library, Strings
* $ONELINER$
* Convert a numeric expression to a character string, zero padded.
* $SYNTAX$
* STRZERO(<nNumber>, [<nLength>], [<nDecimals>]) --> cNumber
* $ARGUMENTS$
* <nNumber> is the numeric expression to be converted to a character
* string.
* <nLength> is the length of the character string to return, including
* decimal digits, decimal point, and sign.
* <nDecimals> is the number of decimal places to return.
* $RETURNS$
* STRZERO() returns <nNumber> 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 <nLength> is less than the number of whole number digits in
* <nNumber>, STR() returns asterisks instead of the number.
*
* * If <nLength> 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 <nLength> is specified but <nDecimals> 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;
}

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

@@ -36,12 +36,12 @@
/* TRANSFORM() tests written by Eddie Runia <eddie@runia.comu> */
/* 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(<x>, <result>) => TEST_CALL(<(x)>, {|| <x> }, <result>)
#translate TEST_LINE( <x>, <result> ) => TEST_CALL(<(x)>, {|| <x> }, <result>)
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