!******************************************************************************!
! Test Calculator Command
! @author Jay P. Hallam
!******************************************************************************!
startmacro s:func[""]
  switch INTERACTIVE interAct GET DEF=TRUE  SDEF=TRUE  ! for normal interactive test(s)

  if func NEQS "" then
    call test_calc_^{func}
    stop
  endif

  result errors {}  ! A table to hold error counts

  call test_calc_symbol_operators
  call test_calc_comparators
  call test_calc_trig_and_angle
  call test_calc_complex
  call test_calc_bit
  call test_calc_misc
  call test_calc_invalid_expression
  call test_calc_radix
  call test_calc_types
  call test_calc_switches
  call test_calc_special_values ! Tests NaN and Inf
  call test_calc_function_collision
  call test_calc_cast           ! Casting output to L:, B:, etc.
  call test_calc_nform          ! The /NFORM switch
  call test_calc_loop           ! BUG 2194 (Calc switches inside loops)

  if interAct isTrue then
    res inst "This should show the results of calculating TEMP to be 3.14. The first &
              two times it should say '3.14' the third time it should say '3' (due &
              to a cast to L:)."

    pipe on
      panel/msgid=MAIN/setup/controls=gc

      gcontrol label macro "MACRO"
      gcontrol menu main "Exit with Status = " "PASS,FAIL" /tleft
      set gc.main.itemcolors {PASS=GREEN,FAIL=RED}

      gcontrol text idtext "Instructions" "^inst" 24 7 /title
!      gcontrol menu main "Exit with Status = " "PASS,FAIL" /tleft
!      set gc.main.itemColors {PASS=GREEN,FAIL=RED}

      shellgui/id=idshellgui/attach
      say ""
      say "nM> CALC/VERBOSE TEMP 3.14"
      CALC/VERBOSE D:TEMP 3.14
      say ""
      say "nM> CALC/VERBOSE D:TEMP 3.14"
      CALC/VERBOSE D:TEMP 3.14
      say ""
      say "nM> CALC/VERBOSE L:TEMP 3.14"
      CALC/VERBOSE L:TEMP 3
      say ""
    pipe off
  endif
endmacro

!******************************************************************************!
procedure processMessage m:msg

  if msg.name eqs "MAIN" then
    assert/text="^reg.main.name: User indicated tests" msg.data eqss "PASS"
    pipe stop
  else
    say "^reg.main.name: Unhandled message name: ^msg.name from fid: ^msg.fid data: ^msg.data"
  endif
return

!******************************************************************************!
! If an unexpected exception is caught, mark test as failed, unless it is expected
!******************************************************************************!
procedure processException m:emsg
  if expectedException REXISTS then
    assert/text="^reg.main.name: Expected ERROR starts with: ^{expectedException}" expectedException EQSS emsg.data.message
    remove expectedException
  else
    assert/text="^reg.main.name: Caught unexpected exception ^{emsg.data}" "FALSE" isTrue
    if "Trace" SUBS ENV.DEBUG then invoke ,, emsg.data.printStackTrace()
  endif
return

!******************************************************************************!
procedure test_calc_symbol_operators
!
!  Test the symbol operators: +, -, *, /, ~, ~*, **, ...
!
  calc x 3+1
  ASSERT/text="CALC: ADDITION (+): integer" x EQ 4

  calc x 3.0 4 +
  ASSERT/text="CALC: ADDITION (+): real,whole" x EQT 7

  calc x 3.1 4.2 +
  ASSERT/text="CALC: ADDITION (+): real,fractional" x EQT 7.3

  calc x 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 + + + + + + + + + + + + + +
  ASSERT/text="CALC: ADDITION (+): 15 integers" x EQ 120

  calc x 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 + + + + + + + + + + + + + + +
  ASSERT/text="CALC: ADDITION (+): 16 integers" x EQ 136

  calc x 999 1000 -
  ASSERT/text="CALC: SUBTRACTION (-): integer" x EQ -1

  calc x 3 4 *
  ASSERT/text="CALC: MULTIPLICATION (*): integer" x EQ 12

  calc x 4 2 /
  ASSERT/text="CALC: DIVISION (/): integer" x EQ 2

  calc x 1 0 /
  ASSERT/text="CALC: DIVISION (/): n/0" "^x" EQS "Infinity"

  calc x 0 1 /
  ASSERT/text="CALC: DIVISION (/): 0/n" x EQ 0

  calc x 0 0 /
  ASSERT/text="CALC: DIVISION (/): 0/n" "^x" EQS "NaN"

  calc x (1,2) ~
  ASSERT/text="CALC: CONJUGATE (~)" x(0) EQ 1 AND x(1) EQ -2

  calc x (1,2) (1,2) ~*
  ASSERT/text="CALC: CONJUGATE MULTIPLY (~*)" x(0) EQ 5 AND x(1) EQ 0

  calc x (2,4) (2,-4) ~/
  ASSERT/text="CALC: CONJUGATE DIVIDE (~/)" x(0) EQ 1 AND x(1) EQ 0

  calc x 2 3 **
  assert/text="CALC: POWER (**)" x EQ 8

return

!******************************************************************************!
procedure test_calc_trig_and_angle
  invoke PI nxm.sys.inc.Constants.PI

  calc x PI/4 "COS"
  call checkResult "COS - Radians" x 0.7071072502792263
  calc x PI/4 "COSD"
  call checkResult "COSD - Degrees" x 0.9999060499602607
  calc x 0.5 "COSC"
  call checkResult "COSC - Cycles" x -1.0

  calc x PI/4 "COS" "ACOS"
  call checkResult "ACOS - Radians" x 0.7853975
  calc x -1 "ACOS"
  call checkResult "ACOS - Radians" x PI
  calc x -1 "ACOSD"
  call checkResult "ACOSD - Degrees" x 180.0
  calc x PI/4 "COSD" "ACOSD"
  call checkResult "ACOSD - Degrees" x 0.7853975
  calc x -1.0 "ACOSC"
  call checkResult "ACOSC - Cycles" x 0.5

  calc x PI/4 "SIN"
  call checkResult "SIN - Radians" x 0.7071063120935576
  calc x PI/4 "SIND"
  call checkResult "SIND - Degrees" x 0.01370734302732555
  calc x 0.25 "SINC"
  call checkResult "SINC - Cycles" x 1.0

  calc x PI/4 "SIN" "ASIN"
  call checkResult "ASIN - Radians" x 0.7853975
  calc x -1 "ASIN"
  call checkResult "ASIN - Radians" x -1.5707963267948966
  calc x PI/4 "SIND" "ASIND"
  call checkResult "ASIND - Degrees" x 0.7853975
  calc x -1 "ASINC"
  call checkResult "ASINC - Cycles" x -0.25

  calc x PI/4 "TAN"
  call checkResult "TAN - Radians" x 1.0
  calc x PI/4 "TAND"
  call checkResult "TAND - Degrees" x 0.013708630953748427
  calc x 0.125 "TANC"
  call checkResult "TANC - Cycles" x 1.0

  calc x PI/4 "TAN" "ATAN"
  call checkResult "ATAN - Radians" x 0.7853975
  calc x -1 "ATAN"
  call checkResult "ATAN - Radians" x -0.7853981633974483
  calc x -1 "ATAND"
  call checkResult "ATAND - Degrees" x -45.0
  calc x PI/4 "TAND" "ATAND"
  call checkResult "TAND to ATAND - Degrees" x 0.7853975
  calc x 1.0 "ATANC"
  call checkResult "ATANC" x 0.125

  calc x 1 1 "ATAN2"
  call checkResult "ATAN2 - Radians" x 0.785398
  calc x 1 1 "ATAN2D"
  call checkResult "ATAN2D - Degrees" x 45.0
  calc x 1 1 "ATAN2C"
  call checkResult "ATAN2C - Cycles" x 0.125

  calc x (4,1) "POLAR"
  call checkTwoResults "POLAR - Radians" x(0) 4.123105625617661 &
                                         x(1) 0.24497866312686414
  calc x (4,4) "POLARD"
  call checkTwoResults "POLARD - Radius" x(0) 5.65685 &
                                         x(1) 45.0
  calc x (4,4) "POLARC"
  call checkTwoResults "POLARC - Radius" x(0) 5.65685 &
                                         x(1) 0.125

  calc x (4,PI) "RECT"
  call checkTwoResults "RECT - Radians" x(0) -4.0 x(1) 4.898587E-16
  calc x (4,180) "RECTD"
  call checkTwoResults "RECTD - Degrees" x(0) -4.0 x(1) 4.898587E-16
  calc x (4,0.5) "RECTC"
  call checkTwoResults "RECTC - Cycles" x(0) -4.0 x(1) 4.898587E-16

  calc x (4,1) "POLAR" "RECT"
  call checkTwoResults "POLAR to RECT" x(0) 4.0 x(1) 1.0
  calc x (4,1) "RECT" "POLAR"
  call checkTwoResults "RECT to POLAR" x(0) 4.0 x(1) 1.0

  calc x (4,1) "PHASE"
  call checkResult "PHASE" x 0.24497866312686414
  calc x (4,1) "PHASED"
  call checkResult "PHASED" x 14.036243
  calc x (4,4) "PHASEC"
  call checkResult "PHASED" x 0.125

return

!******************************************************************************!
procedure test_calc_misc

  calc x (1,2,3) "ABS"
  call checkResult "ABS" x 3.7416573867739413
  calc x (1,2) "ABS"
  call checkResult "ABS" x 2.23606797749979

  calc x (4,1) "ABS"
  call checkResult "ABS" x 4.123105625617661

  calc x 1 50 51 "CLIP"
  call checkResult "CLIP: x > MAX" x 50
  calc x 1 50 0.5 "CLIP"
  call checkResult "CLIP: x < MIN" x 1
  calc x 1 50 42 "CLIP"
  call checkResult "CLIP: MIN < x < MAX" x 42

  calc x 0.5 "DB"
  call checkResult "DB - precision DB conversion - DB(0.5)" x  -3.010299

  calc x 1.0 "DB"
  call checkResult "DB - precision DB conversion - DB(1)" x  0.0

  calc x 2.0 "DB"
  call checkResult "DB - precision DB conversion - DB(2)" x  3.010299

  calc x 5.0 "DB"
  call checkResult "DB - precision DB conversion - DB(5)" x  6.989700

  calc x 10.0 "DB"
  call checkResult "DB - precision DB conversion - DB(10)" x  10.0

  calc x 0 "DB"
  call checkString "DB - precision DB conversion - DB(0)" x -3233.062153431144

  calc x -1 "DB"
  call checkString "DB - precision DB conversion - DB(-1)" x 0.0

  calc x 1 "DB/B"
  call checkResult "DB/B - precision DB conversion (bounded)" x 0.0

  ! Bounded DB (backwards compatiable - floored at 1e-12 and absolute value of input)
  calc x 0 "DB/B"
  call checkResult "DB/B - precision DB conversion (bounded) - DB/B(0)" x -120.0

  calc x -1 "DB/B"
  call checkString "DB/B - precision DB conversion (bounded & ABS) - DB/B(-1)" x 0.0

  calc x 0.5 "DBF"
  call checkResult "DBF - Fast DB conversion" x  -3.0

  calc x (1,2,3) (1,2,3) "DOT"
  call checkResult "DOT" x 14

  calc (1,2) DEMUX =ai =ar
  assert/text="CALC: DEMUX" ar EQ 1 AND ai EQ 2

  calc x 1 "EXP"
  call checkResult "EXP" x 2.7182818284590455

  calc x 0 "FACTORIAL"
  assert/text="CALC: FACTORIAL ZERO (0!)"               x EQ 1
  calc x 1 "FACTORIAL"
  assert/text="CALC: FACTORIAL ONE (1!)"                x EQ 1
  calc x 4 "N!"
  assert/text="CALC: FACTORIAL SMALL POS NUMBER (4!)"   x EQT 24
  calc x 170 "N!"
  assert/text="CALC: FACTORIAL LARGE POS NUMBER (170!)" x EQ 7.257415615308004E306
  ! TODO: -1 factorial of -1 is NOT defined (currently CALC returns 1 for all negative number)
  ! calc x -1 "FACTORIAL"
  ! assert/text="CALC: FACTORIAL NEG NUMBER (-1!)"        x EQ 1
  calc x 200 "FACTORIAL"
  assert/text="Calc: FACTORIAL 200 is larger than double becomes INFINITY" "^x" EQS "Infinity"

  calc x 1.7756845768 "FIX"
  call checkResult "FIX" x 1.0

  calc x 0.25 "FLOOR"
  call checkResult "FLOOR - Positive numbers" x 0.0
  calc x -0.25 "FLOOR"
  call checkResult "FLOOR - Negative numbers" x -1.0

  calc x 0.1 "CEIL"
  call checkResult "CEIL - Positive numbers: 0.1 -> 1.0" x 1.0
  calc x -1.25 "CEIL"
  call checkResult "CEIL - Negative numbers: -1.24 -> -1" x -1.0
  calc x -0.25 "CEIL"
  call checkResult "CEIL - Negative numbers -0.25 -> 0" x 0.0

  calc x 1 "LN"
  call checkResult "LN - Natural Log - LN(1)" x 0.0

  calc x 0 "LN"
  call checkString "LN - Natural Log - LN(0)" x -744.4400719213812

  res e 2.718281828459045
  calc x e "LN"
  call checkResult "LN - Natural Log - LN(E=2.71828)" x 1

  calc x -1 "LN"
  call checkString "LN - Natural Log - LN(-1)" x 0.0

  calc x e "LN/B"
  call checkResult "LN/B - Natural Log (bounded) - LN/B(E=2.71828)" x 1.0

  calc x 1 "LN/B"
  call checkResult "LN/B - Natural Log (bounded) - LN/B(1)" x 0.0

  ! Bounded LN (backwards compatiable - floored at 1e-12 and absolute value of input)
  calc x 0 "LN/B"
  calc y 1e-12 "LN/B"
  call checkResult "LN/B - Natural Log (bounded) - LN/B(0)" x y

  calc x -1 "LN/B"
  call checkResult "LN/B - Natural Log (bounded & ABS)- LN/B(-1)" 0.0

  calc x 10 "LOG"
  call checkResult "LOG - base 10" x 1.0

  calc x 100 10 "LOG" **
  calc y 10 100 ** "LOG"
  call checkResult "LOG - base 10, 100**LOG(10)=LOG(10**100)" x y

  ! for Bug 1454 - near smallest 32-bit (float) number is 1.4e-45 (should not be floored)
  calc x 1e-44 "LOG"
  call checkResult "LOG - base 10, LOG(1e-44) - small 32-bit" x -44

  ! for Bug 1454 - near largest 32-bit (float) number is 3.4e+38
  calc x 1e+38 "LOG"
  call checkResult "LOG - base 10, LOG(1e+38) - large 32-bit" x 38

  ! for Bug 1454 - near smallest 64-bit (double) number is 4.9e-324 (should not be floored)
  calc x 1e-323 "LOG"
  ! NTN: need to reduce tolerance b/c of the very small number that we are working with
  ASSERT/TEXT="CALC: LOG - base 10, LOG(1e-323) - small 64-bit" x EQT -323 /TOL=1e-3

  ! for Bug 1454 - near largest 64-bit (float) number is 1.7e+308
  calc x 1e+308 "LOG"
  call checkResult "LOG - base 10, LOG(1e+308) - large 64-bit" x 308

  ! for Bug 1454 - negative number (log(-x) = log(x))
  calc x -1 "LOG"
  call checkString "LOG - base 10, LOG(-1)" x 0.0

  ! for Bug 1454 - zero (should be large negative number)
  calc x 0 "LOG"
  call checkString "LOG - base 10, LOG(0)" x -323.3062153431144

  calc x 10 "LOG/B"
  call checkResult "LOG - base 10 (bounded)" x 1.0

  calc x 1e-12 "LOG/B"
  call checkResult "LOG - base 10 (bounded), LOG/B(1e-12)" x -12.0

  ! Bounded LOG (backwards compatiable - floored at 1e-12 and absolute value of input)
  calc x 1e-44 "LOG/B"
  call checkResult "LOG - base 10 (bounded), LOG/B(1e-44) - small 32-bit" x -12.0

  calc x 0 "LOG/B"
  call checkResult "LOG - base 10 (bounded) - LOG/B(0)" x -12.0

  calc x -1 "LOG/B"
  call checkResult "LOG - base 10 (bounded) - LOG/B(0)" x 0.0

  calc x (1,2,3) "MAG"
  call checkResult "MAG" x 3.7416573867739413
  calc x (1,2) "MAG"
  call checkResult "MAG" x 2.23606797749979
  calc x (4,1) "MAG"
  call checkResult "MAG" x 4.123105625617661

  calc x (1,2,3) "MAG2"
  call checkResult "MAG2 - Magnitude Squared" x 14.0
  calc x (1,2) "MAG2"
  call checkResult "MAG2 - Magnitude Squared" x 5.0
  calc x (4,1) "MAG2"
  call checkResult "MAG2 - Magnitude Squared" x 17.0

  calc x 1 3 "MAX"
  call checkResult "MAX" x 3.0
  calc x -1 3 "MAX"
  call checkResult "max negative" x 3.0
  calc x 3 1 "MAX"
  call checkResult "MAX" x 3.0
  calc x 3 -1 "MAX"
  call checkResult "MAX" x 3.0
  calc x 1 3 "MIN"
  call checkResult "MIN (1,3)" x 1.0
  calc x -1 3 "MIN"
  call checkResult "MIN (-1,3)" x -1.0
  calc x 3 1 "MIN"
  call checkResult "MIN (3,1)" x 1.0
  calc x 3 -1 "MIN"
  call checkResult "MIN (3,-1)" x -1.0

  ! Truncation Modulo
  calc x 7 5 "MODULOT"
  call checkResult "MODULOT - Positive" x 2.0
  calc x -4 33 "MODULOT"
  call checkResult "MODULOT - Negative" x -4.0
  calc x 2 1.2 "MODULOT"
  call checkResult "MODULOT - (2,1.2)" x 0.8

  ! Floored MODULO
  calc x 8 3 "MOD/F"
  call checkResult "MOD/F - with MAG(Pos) > MAG(Pos") x 2.0
  calc x 8 -3 "MOD/F"
  call checkResult "MOD/F - with MAG(Pos) > MAG(Neg") x -1.0
  calc x -8 3 "MODULOF"
  call checkResult "MODULOF - with MAG(Neg) > MAG(Pos") x 1.0
  calc x -8 -3 "MODULOF"
  call checkResult "MODULOF - with MAG(Neg) > MAG(Neg") x -2.0

  calc x 1 2 "MOD/F"
  call checkResult "MODULOF - with MAG(Pos) < MAG(Pos") x 1.0
  calc x 1 -2 "MOD/F"
  call checkResult "MODULOF - with MAG(Pos) < MAG(Neg") x -1.0
  calc x -1 2 "MOD/F"
  call checkResult "MODULOF - with MAG(Neg) < MAG(Pos") x 1.0
  calc x -1 -2 "MOD/F"
  call checkResult "MODULOF - with MAG(Neg) < MAG(Neg") x -1.0

  ! Euclidean MODULO
  calc x 8 3 "MOD/E"
  call checkResult "MOD/E - with MAG(Pos) > MAG(Pos") x 2.0
  calc x 8 -3 "MOD/E"
  call checkResult "MOD/E - with MAG(Pos) > MAG(Neg") x 2.0
  calc x -8 3 "MODULOE"
  call checkResult "MODULOE - with MAG(Neg) > MAG(Pos") x 1.0
  calc x -8 -3 "MODULOE"
  call checkResult "MODULOE - with MAG(Neg) > MAG(Neg") x 1.0

  calc x 1 2 "MOD/E"
  call checkResult "MODULOE - with MAG(Pos) < MAG(Pos") x 1.0
  calc x 1 -2 "MOD/E"
  call checkResult "MODULOE - with MAG(Pos) < MAG(Neg") x 1.0
  calc x -1 2 "MOD/E"
  call checkResult "MODULOE - with MAG(Neg) < MAG(Pos") x 1.0
  calc x -1 -2 "MOD/E"
  call checkResult "MODULOE - with MAG(Neg) < MAG(Neg") x 1.0


  calc x 3 4 "MUX"
  call checkResult "MUX" x (3.0,4.0)
  calc x 3 4 "MUX" 4 1 "MUX" +
  call checkResult "MUX, COMPLEX ADD" x (7.0,5.0)

  calc x 1.7756845768 "ROUND"
  call checkResult "ROUND" x 2.0

  calc x 127 "POWER2"
  call checkResult "POWER2" x 128.0
  calc x -127 "POWER2"
  call checkResult "POWER2" x 1.0

  calc x random
  assert/text="CALC: RANDOM within range (0-1)" x > 0 AND x < 1

  ! since 3.1.1 to test RANDOM/P and RANDOM/S for BUG 2559
  calc x random/p
  assert/text="CALC: RANDOM/P within range [0-1)" x >= 0 AND x < 1
  calc x random/s
  assert/text="CALC: RANDOM/S within range [0-1)" x >= 0 AND x < 1

  calc x -1 "SQRT"
  call checkString "SQRT -1" x "NaN"
  calc x 2 "SQRT"
  call checkResult "SQRT" x 1.4142135623730951
  calc x 2 "SQUARE"
  call checkResult "SQUARE" x 4

  calc x (-1,-2,3,4)
  calc y X(1)
  call checkResult "VECTOR" y -2.0
  calc y X(3)
  call checkResult "VECTOR" y 4.0

  calc x 3 4 5 "VMUX"
  assert/TEXT="CALC: VMUX" &
         x(0) EQT 3.0 AND x(1) EQT 4.0 AND x(2) EQT 5.0
  calc x 3 4 5 "VMUX" 3 4 5 "VMUX" +
  assert/TEXT="CALC: VMUX addition" &
       x(0) EQT 6.0 AND x(1) EQT 8.0 AND x(2) EQT 10.0

  result vectorDouble (1,2,3)
  calc vectorDouble "VDEMUX" =a3 =a2 =a1
  assert/text="CALC: VDEMUX" a1 EQ 1 AND a2 EQ 2 AND a3 EQ 3

  assert/text="CALC: WRAP/UNWRAP - tested in FCALC" 1 EQ 1

return

!******************************************************************************!
procedure test_calc_comparators

  result L:errors.comparators 0
  calc x 1 0 "LT"
  if x NEQ 0.0 result errors.comparators errors.comparators+1

  calc x 1 0 "LE"
  if x NEQ 0.0 result errors.comparators errors.comparators+1

  calc x 1 1 "LE"
  if x NEQ 1.0 result errors.comparators errors.comparators+1

  calc x 1 1 "LT"
  if x NEQ 0.0 result errors.comparators errors.comparators+1

  calc x 0 1 "LT"
  if x NEQ 1.0 result errors.comparators errors.comparators+1

  calc x 0 1 "LE"
  if x NEQ 1.0 result errors.comparators errors.comparators+1

  calc x 1 0 "GT"
  if x NEQ 1.0 result errors.comparators errors.comparators+1

  calc x 1 0 "GE"
  if x NEQ 1.0 result errors.comparators errors.comparators+1

  calc x 1 1 "GE"
  if x NEQ 1.0 result errors.comparators errors.comparators+1

  calc x 1 1 "GT"
  if x NEQ 0.0 result errors.comparators errors.comparators+1

  calc x 0 1 "GT"
  if x NEQ 0.0 result errors.comparators errors.comparators+1

  calc x 0 1 "GE"
  if x NEQ 0.0 result errors.comparators errors.comparators+1

  calc x 1 1 "EQ"
  if x NEQ 1.0 result errors.comparators errors.comparators+1

  calc x 0 1 "EQ"
  if x NEQ 0.0 result errors.comparators errors.comparators+1

  calc x 1 0 "EQ"
  if x NEQ 0.0 result errors.comparators errors.comparators+1

  assert/text="CALC: COMPARATORS" errors.comparators EQ 0

return

!******************************************************************************!
procedure test_calc_complex
  ! ADDC, CONJ, DIVC, MULC and SUBC tested with operator symbols
  calc x (1,2) (3,4) +
  call checkTwoResults "ADDITION (+): complex" x(0) 4 x(1) 6

  calc x (3,4) (1,2) -
  call checkTwoResults "SUBTRACTION (-): complex" x(0) 2 x(1) 2

  calc x (1,2) (1,2) *
  call checkTwoResults "MULTIPLICATION (*): complex*complex" x(0) -3 x(1) 4

  calc x 2 (1,2) *
  call checkTwoResults "MULTIPLICATION (*): scalar*complex" x(0) 2 x(1) 4

  calc x (1,2) 2 *
  call checkTwoResults "MULTIPLICATION (*): complex*scalar" x(0) 2 x(1) 4

  calc x (1,2) (1,2) /
  call checkTwoResults "DIVISION (/): complex/complex" x(0) 1 x(1) 0

  calc x (2,4) 2 /
  call checkTwoResults "DIVISION (/): complex/scalar" x(0) 1 x(1) 2

  calc x 2 (1,2) /
  call checkTwoResults "DIVISION (/): scalar/complex" x(0) 0.4 x(1) -0.8

  calc x 1 "CMPLX"
  call checkTwoResults "CMPLX" x(0) 1 x(1) 0

  calc xr (1,2) "REAL"
  calc xi (1,2) "IMAG"
  call checkTwoResults "REAL,IMAG" xr 1 xi 2

!  calc x (1,2) log
!  call checkTwoResults "LOG (base 10): complex" x(0) 4 x(1) 6

!  calc x (0,0) log
!  call checkTwoResults "LOG (base 10): complex" x(0) 4 x(1) 6

!  calc x (1,2) db
!  call checkTwoResults "Decibels: complex" x(0) 4 x(1) 6

!  calc x (0,0) db
!  call checkTwoResults "Decibels: complex" x(0) 4 x(1) 6

!  calc x (1,2) ln
!  call checkTwoResults "Natural LOG: complex" x(0) 4 x(1) 6

!  calc x (0,0) ln
!  call checkTwoResults "Natural LOG: complex" x(0) 4 x(1) 6

return

!******************************************************************************!
procedure test_calc_bit
  calc x 1 3 "BXOR"
  call checkResult "BXOR" x 2.0
  calc x 1 3 "BAND"
  call checkResult "BAND" x 1.0
  calc x 1 3 "BOR"
  call checkResult "BOR" x 3.0
  calc x 0x1010 "BNOT"
return

!******************************************************************************!
!  Check the results against what is expected (within tolerance) If failure
!  occurs, print the test name with the expected and actual values obtained
!  from the test.
!
!  (INPUT) testname        - name of the test being run
!  (INPUT) actualValue     - actual result from the test
!  (INPUT) expectedValue   - expected result
!
procedure checkResult s:testname d:actualValue d:expectedValue
  ASSERT/TEXT="CALC: ^testname" actualValue EQT expectedValue
return

procedure checkTwoResults s:testname d:actualValue1 d:expectedValue1 &
                          d:actualValue2 d:expectedValue2

  ASSERT/TEXT="CALC: ^testname" &
       actualValue1 EQT expectedValue1 AND actualValue2 EQT expectedValue2
return

!******************************************************************************!
!  Check the results against what is expected when the two input parameters are
!  strings.  If failure occurs, print the test  name with the expected and
!  actual values obtained from the test.
!
!  (INPUT) testname       - name of the test being run
!  (INPUT) actualString   - actual string result from the test
!  (INPUT) expectedString - expected string value

procedure checkString s:testname d:actualValue s:expectedString

  ASSERT/TEXT="CALC: ^testname" &
      "^actualValue" EQS expectedString
return

!******************************************************************************!
procedure test_calc_invalid_expression
!  This set of tests added by JC4 to check exception handling when CALCULATOR is
!  passed a set of invalid parameters (see DR 504090-1).
!
  ASSERT/TEXT="CALC: TOO MANY OPERATORS (TEST 1 of 4)"/EXCEPT &
        CALCULATOR FOO 2 2 + +
  ASSERT/TEXT="CALC: TOO MANY OPERATORS (TEST 2 of 4)"/EXCEPT &
        CALCULATOR FOO (2,2) (2,2) + +
  ASSERT/TEXT="CALC: TOO MANY OPERATORS (TEST 3 of 4)"/EXCEPT &
        CALCULATOR FOO 2 2 + 1 7 * / 8 - +
  ASSERT/TEXT="CALC: TOO MANY OPERATORS (TEST 4 of 4)"/EXCEPT &
        CALCULATOR FOO 2 +

  ASSERT/TEXT="CALC: TOO FEW OPERATORS (TEST 1 of 6)"/EXCEPT &
        CALCULATOR FOO 2 2 2 +
  ASSERT/TEXT="CALC: TOO FEW OPERATORS (TEST 2 of 6)"/EXCEPT &
        CALCULATOR FOO (2,2) (2,2) (2,2) +
  ASSERT/TEXT="CALC: TOO FEW OPERATORS (TEST 3 of 6)"/EXCEPT &
        CALCULATOR FOO +
  ASSERT/TEXT="CALC: TOO FEW OPERATORS (TEST 4 of 6)"/EXCEPT &
        CALCULATOR FOO 2 2 + 1 7 * / 8 9 -
  ASSERT/TEXT="CALC: TOO FEW OPERATORS (TEST 5 of 6)"/EXCEPT &
        CALCULATOR FOO 2 2
  ASSERT/TEXT="CALC: TOO FEW OPERATORS (TEST 6 of 6)"/EXCEPT &
        CALCULATOR FOO 2 +

  ASSERT/TEXT="CALC: INVALID STRING TYPE (TEST 1 of 1)"/EXCEPT &
        CALCULATOR FOO "abc"
  ASSERT/TEXT="CALC: INVALID STRING TYPE (TEST 2 of 2)"/EXCEPT &
        CALCULATOR FOO "abc" 2 +

  ASSERT/TEXT="CALC: INVALID ARRAY TYPES (TEST 1 of 1)"/EXCEPT &
        CALCULATOR FOO (2,2) (8,0,0,0) +

  ASSERT/TEXT="CALC: INVALID EXPRESSION (TEST 1 of 1)"/EXCEPT &
        CALCULATOR FOO 0c0 +

return

!******************************************************************************!
procedure test_calc_radix
!  This set of tests added by JC4 to check use of /HEX and /BIN and the input of
!  hex and binary values.
!
  ! Hex Values
  CALCULATOR FOO 0x10 0x11 +
  ASSERT/TEXT="CALC: TEST HEX VALUES (TEST 1 of 3)" FOO EQ 33

  CALCULATOR FOO 0x10 0x11 -
  ASSERT/TEXT="CALC: TEST HEX VALUES (TEST 2 of 3)" FOO EQ -1

  ASSERT/TEXT="CALC: TEST HEX VALUES (TEST 3 of 3)" 0x10 EQ 16


  ! Binary Values
  CALCULATOR FOO 0b10 0b11 +
  ASSERT/TEXT="CALC: TEST BINARY VALUES (TEST 1 of 3)" FOO EQ 5

  CALCULATOR FOO 0b10 0b11 -
  ASSERT/TEXT="CALC: TEST BINARY VALUES (TEST 2 of 3)" FOO EQ -1

  ASSERT/TEXT="CALC: TEST BINARY VALUES (TEST 3 of 3)" 0b10 EQ 2


  ! Hex + Binary + Decimal Values
  CALCULATOR FOO 0b10 0x10 + 8 +
  ASSERT/TEXT="CALC: TEST MIXED-RADIX VALUES (TEST 1 of 4)" FOO EQ 26

  CALCULATOR FOO 0b10 0x10 +
  ASSERT/TEXT="CALC: TEST MIXED-RADIX VALUES (TEST 2 of 4)" FOO EQ 0x12

  CALCULATOR FOO 0x10 10 +
  ASSERT/TEXT="CALC: TEST MIXED-RADIX VALUES (TEST 3 of 4)" FOO EQ 26

  CALCULATOR FOO 0b10 10 +
  ASSERT/TEXT="CALC: TEST MIXED-RADIX VALUES (TEST 4 of 4)" FOO EQ 12

  ! /HEX
  res s:hexTen "0x0000000A"
  CALCULATOR/HEX TEN 10
  assert/text="CALC: TEST /HEX SWITCH" TEN EQS hexTen

  ! /BIN
  res s:binTen "0b00000000000000000000000000001010"
  CALCULATOR/BIN TEN 10
  assert/text="CALC: TEST /BIN SWITCH" TEN EQS binTen

return

!******************************************************************************!
procedure test_calc_types
!  This set of tests added by JC4 to check use of various data types.
!
  ! Double
  CALCULATOR/TYPE=D FOO 3.4E38 2E23 +
  ASSERT/TEXT="CALC: TEST /TYPE=D (TEST 1 of 2)" FOO EQ 3.400000000000002E38

  CALCULATOR/TYPE=D FOO 3.4E38 2E32 +
  ASSERT/TEXT="CALC: TEST /TYPE=D (TEST 2 of 2)" FOO EQ 3.400002E38

  CALCULATOR/TYPE=D FOO 3.4E38 2 + 3.4E38 -
  ASSERT/TEXT="CALC: TEST /TYPE=D (TEST 3 of 3)" FOO EQ 0

  ! Float
  CALCULATOR/TYPE=F VALID 2E38 2 + 2E38 eq
  ASSERT/TEXT="CALC: TEST /TYPE=F (TEST 1 of 3)" VALID isTrue

  CALCULATOR/TYPE=F VALID 2E38 2E35 + 2.002E38 eq
  ASSERT/TEXT="CALC: TEST /TYPE=F (TEST 2 of 3)" VALID isTrue

  CALCULATOR/TYPE=F FOO 2E38 2 + 2E38 -
  ASSERT/TEXT="CALC: TEST /TYPE=F (TEST 3 of 3)" FOO EQ 0

  ! Long
  CALCULATOR/TYPE=L FOO 1.9 0.1 +
  ASSERT/TEXT="CALC: TEST /TYPE=L (TEST 1 of 2)" FOO EQ 1

  CALCULATOR/TYPE=L FOO 1 0.1 +
  ASSERT/TEXT="CALC: TEST /TYPE=L (TEST 2 of 2)" FOO EQ 1
return

!******************************************************************************!
procedure test_calc_switches
!  This set of tests added by JC4 to use of switches as arguments.
!
  CALCULATOR FOO 1.0 1.0 +
  ASSERT/TEXT="CALC: NO SWITCHES" FOO EQ 2.0

  ! If switch is not present it should resolve to -1.0
  CALCULATOR FOO 1.0 /ONE +
  ASSERT/TEXT="CALC: SWITCH NOT PRESENT" FOO EQ 0.0

  ! If switch is present it should resolve to the value of the switch
  CALCULATOR/ONE=1.0 FOO 1.0 /ONE +
  ASSERT/TEXT="CALC: SWITCH IS PRESENT" FOO EQ 2.0

return

!******************************************************************************!
procedure test_calc_special_values
!  This set of tests added by JC4 to use of NaN and Inf.
!
  CALCULATOR FOO 0 0 /
  INVOKE isNaN java.lang.Double.isNaN(foo)
  ASSERT/TEXT="CALC: 0 / 0 = NaN" isNaN isTrue

  CALCULATOR FOO NaN 1 +
  INVOKE isNaN java.lang.Double.isNaN(foo)
  ASSERT/TEXT="CALC: NaN + 1 = NaN" isNaN isTrue

  CALCULATOR FOO 1 0 /
  INVOKE isInf java.lang.Double.isInfinite(foo)
  ASSERT/TEXT="CALC: 1 / 0 = Infinity" isInf isTrue AND foo GT 0.0

  CALCULATOR FOO -1 0 /
  INVOKE isInf java.lang.Double.isInfinite(foo)
  ASSERT/TEXT="CALC: -1 / 0 = -Infinity" isInf isTrue AND foo LT 0.0

  CALCULATOR FOO Infinity 1.0 +
  INVOKE isInf java.lang.Double.isInfinite(foo)
  ASSERT/TEXT="CALC: Infinity + 1 = Infinity" isInf isTrue AND foo GT 0.0

  CALCULATOR FOO -Infinity 1.0 +
  INVOKE isInf java.lang.Double.isInfinite(foo)
  ASSERT/TEXT="CALC: Infinity + 1 = Infinity" isInf isTrue AND foo LT 0.0

return

!******************************************************************************!
procedure test_calc_function_collision
  result SCALE 2
  calc x SCALE 2 *
  assert/text="CALC: SCALE 2 * (RESULT MATCHES OPERATOR!) " x EQ 4
  remove scale
return

!******************************************************************************!
procedure test_calc_cast
!  This set of tests added to test casting of output values (see Bug 1211)
!
  call test_calc_castx  2.0  1.0  1.0   ! Round down when val > 0, fraction =0.0
  call test_calc_castx  2.4  1.2  1.0   ! Round down when val > 0, fraction <0.5
  call test_calc_castx  3.0  1.5  1.0   ! Round down when val > 0, fraction =0.5
  call test_calc_castx  3.4  1.7  1.0   ! Round down when val > 0, fraction >0.5

  call test_calc_castx -2.0 -1.0 -1.0   ! Round down when val < 0, fraction =0.0
  call test_calc_castx -2.4 -1.2 -1.0   ! Round down when val < 0, fraction <0.5
  call test_calc_castx -3.0 -1.5 -1.0   ! Round down when val < 0, fraction =0.5
  call test_calc_castx -3.4 -1.7 -1.0   ! Round down when val < 0, fraction >0.5

return

procedure test_calc_castx d:val d:dexp d:lexp
  CALCULATOR FOO val 2 /
  ASSERT/TEXT="CALC: ^{val}/2 ->   FOO = ^foo" foo eqt dexp   ! Use eqt to account for rounding error

  CALCULATOR D:FOO val 2 /
  ASSERT/TEXT="CALC: ^{val}/2 -> D:FOO = ^foo" foo eqt dexp   ! Use eqt to account for rounding error

  CALCULATOR F:FOO val 2 /
  ASSERT/TEXT="CALC: ^{val}/2 -> F:FOO = ^foo" foo eqt dexp   ! Use eqt to account for rounding error

  CALCULATOR X:FOO val 2 /
  ASSERT/TEXT="CALC: ^{val}/2 -> X:FOO = ^foo" foo eq lexp

  CALCULATOR L:FOO val 2 /
  ASSERT/TEXT="CALC: ^{val}/2 -> L:FOO = ^foo" foo eq lexp

  CALCULATOR I:FOO val 2 /
  ASSERT/TEXT="CALC: ^{val}/2 -> I:FOO = ^foo" foo eq lexp

  CALCULATOR B:FOO val 2 /
  ASSERT/TEXT="CALC: ^{val}/2 -> B:FOO = ^foo" foo eq lexp
return

!******************************************************************************!
procedure test_calc_nform
!
!  NFORM/JAVA - TEST 1
!
result D:dval 1.12345678
res answer "1.123"
res L:i 1
calc str dval /NFORM="#.###"
assert/text="CALC: /NFORM test ^i" "^str" EQS "^answer"

!
!  NFORM/JAVA - TEST 2
!
result D:dval 1
res answer "1.00"
calc i i+1
calc str dval /NFORM="0.00"
assert/text="CALC: /NFORM test ^i" "^str" EQS "^answer"

!
!  NFORM/FORTRAN
!
result D:dval 1
res answer "1.00"
res formatStr "(F3.2)"
calc str dval /NFORM="^{formatStr}"
assert/text="CALC: /NFORM, format=^formatStr" "^str" EQS "^answer"


!        GEN    - X-Midas GENeral format (no exponent if between 1E-3, 1E15).
!        VIS    - X-Midas VISual  format (no exponent if between 1E-3, 1E7).
!        SCI    - SCIentific notation.
!        ENG    - ENGineering notation   (exponent is a multiple of 3).
!        MAN    - MANtissa notation      (no exponents).
!        DMS    - Deg-Min-Sec angular format.            ddd'mm'ss
!        LAT    - Deg-Min-Sec format for latitude.       ddd'mm'ssN
!        LON    - Deg-Min-Sec format for longitude.      ddd'mm'ssE
!        STD    - STanDard time code format.             [yy]yy:mm:dd::hh:mm:ss
!        ACQ    - ACQisition time code format.           [yy.ddd]:[hh:mm:ss]
!        EPOCH  - EPOCH quadwords for time code.         [yy]yy:sec_in_year
!        NORAD  - NORAD timecode format.                 yyddd.frac_of_day
!        TCR    - TimeCode Reader format.                ddd:hh:mm:ss
!        VAX    - VAX time format.                       dd-MMM-yy[yy]:hh:mm:ss
!        HMS    - Hour-Min-Sec time format.              hh:mm:ss.ffff
!        YMD    - Year-Month-Day format.                 yyyy:mm:dd
!        NET    - 32-bit integer formatted as URL.       127.0.0.1

set numFormatTable {}
set numFormatTable.GEN   {DVAL=123456789.123456789,ANSWER="123456789.1235"}
set numFormatTable.VIS   {DVAL=123456789.123456789,ANSWER="1.234568E+008"}
set numFormatTable.SCI   {DVAL=123456789.123456789,ANSWER="1.234568E+008"}
set numFormatTable.ENG   {DVAL=123456789.123456789,ANSWER="123.456789E+006"}
set numFormatTable.MAN   {DVAL=123456789.123456789,ANSWER="123456789"}
set numFormatTable.DMS   {DVAL=12.2,ANSWER="12'12'00"}
set numFormatTable.LAT   {DVAL=38.35123,ANSWER="38'21'04"}
set numFormatTable.LON   {DVAL=-179.35123,ANSWER="-179'21'04"}
set numFormatTable.STD   {DVAL=1.907462269777E9,ANSWER="2010:06:12::02:37:49.777"}
set numFormatTable.ACQ   {DVAL=1.907462269777E9,ANSWER="10.163:02:37:49.777"}
set numFormatTable.EPOCH {DVAL=1.907462269777E9,ANSWER="2010:14006269.777"}
set numFormatTable.NORAD {DVAL=1.907462269777E9,ANSWER="10163.10960390"}
set numFormatTable.TCR   {DVAL=1.907462269777E9,ANSWER="163:02:37:49.777"}
set numFormatTable.VAX   {DVAL=1.907462269777E9,ANSWER="12-JUN-2010:02:37:49.777"}
set numFormatTable.HMS   {DVAL=1.907462269777E9,ANSWER="02:37:49.777"}
set numFormatTable.YMD   {DVAL=1.907462269777E9,ANSWER="2010:06:12"}
set numFormatTable.NET   {DVAL=0x7f000001,ANSWER="127.0.0.1"}

foreach key intable numFormatTable
  calc/reuse=false str numFormatTable.^{key}.DVAL /NFORM="^key"
  assert/text="CALC: /NFORM, format=^key val=^str" "^str" EQS "^numFormatTable.^{key}.ANSWER"
endfor

return

!******************************************************************************!
procedure test_calc_loop
!  This tests using CALC inside a FOREACH loop (BUG 2194)
!
  res tab {}
  res tab.HEX  {HEX=true,ANSWER="0x0000000A",DVAL=10}
  res tab.HEX2 {HEX=false,ANSWER="11.0",DVAL=11}

  foreach key intable tab
    CALCULATOR/reuse=f/HEX=^tab.^{key}.hex ans ^tab.^{key}.dval
    res s:str ^ans  ! convert to string
    assert/text="CALC: /HEX=^{tab.^{key}.hex} val=^str = ^{tab.^{key}.answer}" str EQS "^{tab.^{key}.answer}"
  endfor

return
