From 77436441f0ad32a63156d8cfc6ecab418d83074e Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Mon, 7 Feb 2000 11:26:02 +0000 Subject: [PATCH] 20000207-12:22 GMT+1 Victor Szakats --- harbour/ChangeLog | 9 ++++++ harbour/source/rtl/math.c | 51 +++++++++++++++++++++---------- harbour/tests/regress/rt_hvm.prg | 29 ++++++++++++++++++ harbour/tests/regress/rt_math.prg | 48 +++++++++++++++++++++++++++++ 4 files changed, 121 insertions(+), 16 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 32ae91b8b5..cff9b807b6 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,12 @@ +20000207-12:22 GMT+1 Victor Szakats + * source/rtl/math.c + ! MOD(): Added value substitution on error. + ! MOD(): Made completely CA-Cl*pper compatible including + bugs/side-effects (related to behaviour on zero base value). + * tests/regress/rt_hvm.prg + tests/regress/rt_math.prg + + % and MOD() tests added. All of them passes. + 20000207-09:15 GMT+1 Antonio Linares * source/debug/debugger.prg * Mouse support to select any window. diff --git a/harbour/source/rtl/math.c b/harbour/source/rtl/math.c index 086afaa659..b3745b33e3 100644 --- a/harbour/source/rtl/math.c +++ b/harbour/source/rtl/math.c @@ -269,7 +269,7 @@ HARBOUR HB_MAX( void ) if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) ) { /* NOTE: The order of these if() branches is significant, */ - /* Please, don't change it. */ + /* please, don't change it. [vszakats] */ if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) ) { @@ -329,7 +329,7 @@ HARBOUR HB_MIN( void ) if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) ) { /* NOTE: The order of these if() branches is significant, */ - /* Please, don't change it. */ + /* please, don't change it. [vszakats] */ if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) ) { @@ -380,22 +380,26 @@ HARBOUR HB_MIN( void ) } } -/* TOFIX: In Clipper this is written in Clipper, see the source below, */ -/* and the error handling is NOT made here, but in the % operator */ +/* NOTE: In Clipper this is written in Clipper, see the source below, + and the error handling is NOT made here, but in the % operator. + [vszakats] */ + +/* NOTE: CA-Clipper is buggy since it relies on the fact that the errorhandler + will silently handle zero division errors. [vszakats] */ + +/* NOTE: This C version fully emulates the behaviour of the original + CA-Cl*pper version, including bugs/side-effects. [vszakats] */ HARBOUR HB_MOD( void ) { + /* -FUNCTION MOD(cl_num, cl_base) +FUNCTION MOD( cl_num, cl_base ) + LOCAL cl_result := cl_num % cl_base - LOCAL cl_result - - cl_result = cl_num % cl_base - - RETURN IF( cl_base = 0, ; - cl_num,; - IF(cl_result * cl_base < 0, cl_result + cl_base, cl_result) ) + RETURN IF( cl_base = 0, cl_num, iif( cl_result * cl_base < 0, cl_result + cl_base, cl_result ) ) */ + PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); if( pNumber && ISNUM( 2 ) ) @@ -414,15 +418,30 @@ FUNCTION MOD(cl_num, cl_base) } else { - int iDec; + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ZERODIV, 1341, NULL, "%" ); - hb_itemGetNLen( pNumber, NULL, &iDec ); + if( pResult ) + { + int iDec; - hb_retndlen( dNumber, 0, iDec ); + hb_itemRelease( pResult ); + + hb_itemGetNLen( pNumber, NULL, &iDec ); + + hb_retndlen( dNumber, 0, iDec ); + } } } else - hb_errRT_BASE( EG_ARG, 1085, NULL, "%" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1085, NULL, "%" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } } double hb_numRound( double dResult, int iDec ) diff --git a/harbour/tests/regress/rt_hvm.prg b/harbour/tests/regress/rt_hvm.prg index 0ddf059feb..cc26f90ae6 100644 --- a/harbour/tests/regress/rt_hvm.prg +++ b/harbour/tests/regress/rt_hvm.prg @@ -659,6 +659,35 @@ FUNCTION Main_HVM() TEST_LINE( Str( 4 % 2.0 ) , " 0.00" ) TEST_LINE( Str( 2 % 4.0 ) , " 2.00" ) + TEST_LINE( Str( 3 % 3 ) , " 0" ) + TEST_LINE( Str( 3 % 2 ) , " 1" ) + TEST_LINE( Str( 3 % 1 ) , " 0" ) + TEST_LINE( Str( 3 % 0 ) , "E BASE 1341 Zero divisor % F:S" ) + TEST_LINE( Str( 3 % -1 ) , " 0" ) + TEST_LINE( Str( 3 % -2 ) , " 1" ) + TEST_LINE( Str( 3 % -3 ) , " 0" ) + TEST_LINE( Str( -3 % 3 ) , " 0" ) + TEST_LINE( Str( -3 % 2 ) , " -1" ) + TEST_LINE( Str( -3 % 1 ) , " 0" ) + TEST_LINE( Str( -3 % 0 ) , "E BASE 1341 Zero divisor % F:S" ) + TEST_LINE( Str( -3 % -1 ) , " 0" ) + TEST_LINE( Str( -3 % -2 ) , " -1" ) + TEST_LINE( Str( -3 % -3 ) , " 0" ) + TEST_LINE( Str( 3 % 3 ) , " 0" ) + TEST_LINE( Str( 2 % 3 ) , " 2" ) + TEST_LINE( Str( 1 % 3 ) , " 1" ) + TEST_LINE( Str( 0 % 3 ) , " 0" ) + TEST_LINE( Str( -1 % 3 ) , " -1" ) + TEST_LINE( Str( -2 % 3 ) , " -2" ) + TEST_LINE( Str( -3 % 3 ) , " 0" ) + TEST_LINE( Str( 3 % -3 ) , " 0" ) + TEST_LINE( Str( 2 % -3 ) , " 2" ) + TEST_LINE( Str( 1 % -3 ) , " 1" ) + TEST_LINE( Str( 0 % -3 ) , " 0" ) + TEST_LINE( Str( -1 % -3 ) , " -1" ) + TEST_LINE( Str( -2 % -3 ) , " -2" ) + TEST_LINE( Str( -3 % -3 ) , " 0" ) + /* The order of these tests is relevant, don't change it */ nA := 1 diff --git a/harbour/tests/regress/rt_math.prg b/harbour/tests/regress/rt_math.prg index f59676afb1..c763b62af6 100644 --- a/harbour/tests/regress/rt_math.prg +++ b/harbour/tests/regress/rt_math.prg @@ -425,4 +425,52 @@ FUNCTION Main_MATH() TEST_LINE( Str(sdDate - sdDate ) , " 0" ) TEST_LINE( Str(1234567890 * 1234567890 ) , " 1524157875019052100" ) /* Bug in CA-Cl*pper, it returns: " 1524157875019052000" */ + /* MOD() */ + + TEST_LINE( MOD() , "E BASE 1085 Argument error % F:S" ) + TEST_LINE( MOD( "A", "B" ) , "E BASE 1085 Argument error % F:S" ) + TEST_LINE( MOD( "A", 100 ) , "E BASE 1085 Argument error % F:S" ) + TEST_LINE( MOD( 100, "B" ) , "E BASE 1085 Argument error % F:S" ) + TEST_LINE( MOD( NIL, NIL ) , "E BASE 1085 Argument error % F:S" ) + TEST_LINE( MOD( 100, 60, "A" ) , 40.00 ) + + TEST_LINE( MOD( 1, 0 ) , "E BASE 1341 Zero divisor % F:S" ) + TEST_LINE( MOD( 1, NIL ) , "E BASE 1085 Argument error % F:S" ) + TEST_LINE( Str( MOD( 1, 0 ) ) , "E BASE 1341 Zero divisor % F:S" ) + TEST_LINE( Str( MOD( 2, 4 ) ) , " 2.00" ) + TEST_LINE( Str( MOD( 4, 2 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( 4, 2.0 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( 2, 4.0 ) ) , " 2.00" ) + TEST_LINE( Str( MOD( 8, 3 ) ) , " 2.00" ) + + TEST_LINE( Str( MOD( 3, 3 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( 3, 2 ) ) , " 1.00" ) + TEST_LINE( Str( MOD( 3, 1 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( 3, 0 ) ) , "E BASE 1341 Zero divisor % F:S" ) + TEST_LINE( Str( MOD( 3, -1 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( 3, -2 ) ) , " -1.00" ) + TEST_LINE( Str( MOD( 3, -3 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( -3, 3 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( -3, 2 ) ) , " 1.00" ) + TEST_LINE( Str( MOD( -3, 1 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( -3, 0 ) ) , "E BASE 1341 Zero divisor % F:S" ) + TEST_LINE( Str( MOD( -3, -1 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( -3, -2 ) ) , " -1.00" ) + TEST_LINE( Str( MOD( -3, -3 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( 3, 3 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( 2, 3 ) ) , " 2.00" ) + TEST_LINE( Str( MOD( 1, 3 ) ) , " 1.00" ) + TEST_LINE( Str( MOD( 0, 3 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( -1, 3 ) ) , " 2.00" ) + TEST_LINE( Str( MOD( -2, 3 ) ) , " 1.00" ) + TEST_LINE( Str( MOD( -3, 3 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( 3, -3 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( 2, -3 ) ) , " -1.00" ) + TEST_LINE( Str( MOD( 1, -3 ) ) , " -2.00" ) + TEST_LINE( Str( MOD( 0, -3 ) ) , " 0.00" ) + TEST_LINE( Str( MOD( -1, -3 ) ) , " -1.00" ) + TEST_LINE( Str( MOD( -2, -3 ) ) , " -2.00" ) + TEST_LINE( Str( MOD( -3, -3 ) ) , " 0.00" ) + RETURN NIL +