t_id
99
t_version
1.1
t_adddate
2003/10/03
t_result
0
t_knownrunerror
0
tr_id | run | tr_ok | tr_skip | tr_result |
---|---|---|---|---|
482478720 | 941232 | True | False | Successfully run |
Record count: 1
{ %VERSION=1.1 } {****************************************************************} { CODE GENERATOR TEST PROGRAM } {****************************************************************} { NODE TESTED : secondadd() FPU currency type code } {****************************************************************} { PRE-REQUISITES: secondload() } { secondassign() } { secondtypeconv() } {****************************************************************} { DEFINES: } { FPC = Target is FreePascal compiler } {****************************************************************} { REMARKS: } { } { } { } {****************************************************************} { Result is either LOC_FPU or LOC_REFERENCE } { LEFT NODE (operand) (left operator) } { LOC_REFERENCE / LOC_MEM } { LOC_FPU } { RIGHT NODE (operand) } { LOC_FPU } { LOC_REFERENCE / LOC_MEM } procedure fail; begin WriteLn('Failed!'); halt(1); end; Procedure CurrencyTestSub; var i : Currency; j : Currency; result : boolean; Begin Write('Currency - Currency test...'); result := true; i:=99.9; j:=10.0; i:=i-j; if trunc(i) <> trunc(89.9) then result := false; WriteLn('Result (89.9) :',i); i:=j-i; if trunc(i) <> trunc(-79.9) then result := false; WriteLn('Result (-79.9) :',i); j:=j-10.0; if j <> 0.0 then result := false; WriteLn('Result (0.0) :',j); if not result then Fail else WriteLn('Success.'); end; procedure CurrencyTestAdd; var i : Currency; j : Currency; result : boolean; Begin WriteLn('Currency + Currency test...'); result := true; i:= 9; i:=i+1.5; if trunc(i) <> trunc(10.5) then result := false; WriteLn('Result (10.5) :',i); i := 0.0; j := 100.0; i := i + j + j + 12.5; if trunc(i) <> trunc(212.5) then result := false; WriteLn('Result (212.5) :',i); if not result then Fail else WriteLn('Success.'); end; procedure CurrencyTestmul; var i : Currency; j : Currency; result : boolean; begin WriteLn('Currency * Currency test...'); result := true; i:= 0; j:= 0; i := i * j * i; if trunc(i) <> trunc(0.0) then result := false; WriteLn('Result (0.0) :',i); i := 10.0; j := -12.0; i := i * j * 10.0; if trunc(i) <> trunc(-1200.0) then result := false; WriteLn('Result (-1200.0) :',i); if not result then Fail else WriteLn('Success.'); end; Procedure CurrencyTestDiv; var i : Currency; j : Currency; result : boolean; Begin result := true; WriteLn('Currency / Currency test...'); i:=-99.9; j:=10.0; i:=i / j; if trunc(i) <> trunc(-9.9) then result := false; WriteLn('Result (-9.9) :',i); i:=j / i; if trunc(i) <> trunc(-1.01) then result := false; WriteLN('Result (-1.01) :',i); j:=i / 10.0; if trunc(j) <> trunc(-0.1001) then result := false; WriteLn('Result (-0.1001) :',j); if not result then Fail else WriteLn('Success.'); end; { Procedure CurrencyTestComplex; var i : real; Begin Write('RESULT SHOULD BE 2.09 :'); i := 4.4; WriteLn(Sqrt(i)); Write('RESULT SHOULD BE PI :'); WriteLn(Pi); Write('RESULT SHOULD BE 4.0 :'); WriteLn(Round(3.6)); end;} procedure CurrencyTestequal; var i : Currency; j : Currency; result : boolean; begin result := true; Write('Currency = Currency test...'); i := 1000.0; j := 1000.0; if not (trunc(i) = trunc(j)) then result := false; if not (trunc(i) = trunc(1000.0)) then result := false; if not result then Fail else WriteLn('Success.'); end; procedure CurrencyTestnotequal; var i : Currency; j : Currency; result : boolean; begin result := true; Write('Currency <> Currency test...'); i := 1000.0; j := 1000.0; if (trunc(i) <> trunc(j)) then result := false; if (trunc(i) <> trunc(1000.0)) then result := false; if not result then Fail else WriteLn('Success.'); end; procedure CurrencyTestle; var i : Currency; j : Currency; result : boolean; begin result := true; Write('Currency <= Currency test...'); i := 1000.0; j := 1000.0; if not (trunc(i) <= trunc(j)) then result := false; if not (trunc(i) <= trunc(1000.0)) then result := false; i := 10000.0; j := 999.0; if trunc(i) < trunc(j) then result := false; if trunc(i) < trunc(999.0) then result := false; if not result then Fail else WriteLn('Success.'); end; procedure CurrencyTestge; var i : Currency; j : Currency; result : boolean; begin result := true; Write('Currency >= Currency test...'); i := 1000.0; j := 1000.0; if not (trunc(i) >= trunc(j)) then result := false; if not (trunc(i) >= trunc(1000.0)) then result := false; i := 999.0; j := 1000.0; if trunc(i) > trunc(j) then result := false; if trunc(i) > trunc(999.0) then result := false; if not result then Fail else WriteLn('Success.'); end; Begin CurrencyTestEqual; CurrencyTestNotEqual; CurrencyTestLE; CurrencyTestGE; CurrencyTestSub; CurrencyTestAdd; CurrencyTestDiv; CurrencyTestMul; { CurrencyTestComplex;} end. { $Log: taddcurr.pp,v $ Revision 1.1 2002/09/18 18:29:07 carl * currency cg tests (tested againt Delphi 3) }