Files
harbour-core/harbour/tests/mathtest.prg
Viktor Szakats a334469c05 2012-10-11 11:48 UTC+0200 Viktor Szakats (harbour syenar.net)
* extras/hbxlsxml/xlsxml.prg
  * extras/httpsrv/modules/info.prg
  * extras/httpsrv/modules/showcounter.prg
  * extras/httpsrv/modules/testajax.prg
  * tests/mathtest.prg
  * tests/memfile.prg
  * tests/memory.prg
  * tests/memtst.prg
  * tests/memvar.prg
  * tests/newrdd.prg
  * contrib/hbmisc/hbeditc.c
    * formatting

  * src/rdd/usrrdd/rdds/hscdx.prg
  * src/rdd/usrrdd/rdds/rlcdx.prg
    * hbformat, manual fixups

  * contrib/hbformat/hbfmtcls.prg
    * added TOFIX for not recognizing INIT/EXIT PROCEDURE 
      statements

  * tests/memtst.prg
    ! typo in comment

  * tests/mathtest.prg
    ! added CLS to run well under hbrun
2012-10-11 09:50:31 +00:00

98 lines
2.7 KiB
Plaintext

/*
* $Id$
*/
#include "hbmath.ch"
PROCEDURE Main()
LOCAL nOldMathErrMode
LOCAL bOldMathErr
CLS
? "Testing math function: EXP(), LOG() and SQRT():"
?
? " I) Test with correct arguments:"
? " exp(0.0) == 1.00 ? ", Exp( 0.0 )
? " exp(1.0) == 2.71(8)... ? ", Exp( 1.0 )
? " exp(-1.0) == 0.36(7)... ? ", Exp( -1.0 )
?
? " log(1.0) == 0.00 ? ", Log( 1.0 )
? " log(2.7) == 0.99(3)... ? ", Log( 2.7 )
? " log(0.36) == -1.02(1)... ? ", Log( 0.36 )
?
? " sqrt(1.0) == 1.00 ? ", Sqrt( 1.0 )
? " sqrt(4.0) == 2.00 ? ", Sqrt( 4.0 )
? " sqrt(2.0) == 1.41(4).. ? ", Sqrt( 2.0 )
?
? " II) Test with numeric but incorrect arguments:"
?
? " IIa) default error handling(by the functions themselves)"
? " exp(-1000) == 0.00 ?", Exp( -1000 )
? " exp(1000) == ****... ?", Exp( 1000 )
?
? " log(0) == ****... ?", Log( 0 )
? " log(-10) == *****... ?", Log( -10 )
?
? " sqrt(-4) == 0.00 ?", Sqrt( -4 )
?
nOldMathErrMode := hb_matherMode( HB_MATH_ERRMODE_USERDEFAULT )
? " IIb) error handling by error(hb_MathErMode() == HB_MATH_ERRMODE_USERDEFAULT)"
? " exp(-1000) == 0.00 ?", Exp( -1000 )
? " exp(1000) == ****... ?", Exp( 1000 )
?
? " log(0) == ****... ?", Log( 0 )
? " log(-10) == *****... ?", Log( -10 )
?
? " sqrt(-4) == 0.00 ?", Sqrt( -4 )
?
hb_matherMode( nOldMathErrMode )
bOldMathErr := hb_matherBlock( {| nType, cFuncname, cError, nArg1, nArg2, aInfo |;
localmatherr( nType, cFuncname, cError, nArg1, nArg2, aInfo ) } )
? " IIc) error handling by callback block(hb_MathErBlock())"
? " exp(-1000) == ?", Exp( -1000 )
? " exp(1000) == ?", Exp( 1000 )
?
? " log(0) == ?", Log( 0 )
? " log(-10) == ?", Log( -10 )
?
? " sqrt(-4) == ?", Sqrt( -4 )
hb_matherBlock( bOldMathErr )
RETURN
FUNCTION localmatherr( nType, cFuncname, cError, nArg1, nArg2, aInfo )
LOCAL cStr := "!! Local handling of math error MATH/"
cStr += hb_ntos( nType ) + " in " + cFuncname + "("
IF HB_ISNUMERIC( nArg1 )
cStr += hb_ntos( nArg1 )
ENDIF
IF HB_ISNUMERIC( nArg2 )
cStr += "," + hb_ntos( nArg2 )
ENDIF
cStr += "):"
? cStr
? "!! " + cError
IF aInfo[ HB_MATHERRORBLOCK_HANDLED ]
? "!! --> already handled with return value: " + ;
hb_ntos( aInfo[ HB_MATHERRORBLOCK_RETVAL ] )
RETURN 1
ENDIF
? "!! setting return value to --> 5.0"
aInfo[ HB_MATHERRORBLOCK_RETVAL ] := 5.0
aInfo[ HB_MATHERRORBLOCK_HANDLED ] := .T.
RETURN 1