{ Program to test Code generator secondadd() } { with int64 values } { FUNCTIONAL PRE-REQUISITES: } { - assignments function correctly. } { - if statements function correctly. } { - subroutine calls function correctly. } procedure fail; begin WriteLn('Failed!'); halt(1); end; procedure int64TestAdd; var i: int64; j: int64; result : boolean; begin Write('int64 + int64 test...'); result := true; i:=0; j:=0; i := i + -10000; if i <> -10000 then result := false; j := 32767; i := i + j; if i <> 22767 then result := false; i := i + j + 50000; if i <> 105534 then result := false; i:=0; j:=10000; i:= i + j + j + i + j; if i <> 30000 then result := false; if not result then Fail else WriteLn('Success.'); end; procedure int64TestSub; var i, j, k : int64; result : boolean; begin Write('int64 - int64 test...'); result := true; i:=100000; j:=54; k:=56; i:= i - 100; if i <> 99900 then result := false; i := i - j - k - 100; if i <> 99690 then result := false; i:=100; j:=1000; k:=100; i:= j - i - k; if i <> 800 then result := false; j := 900 - i; if (j <> 100) then result := false; i := 1000000000; k := i; i := i * 10; j := 1000000000 - i; k := k - i; if j <> k then result := false; if j <> (1000000000-(int64(1000000000) * 10)) then result := false; j := (int64(1) shl 33); i := (int64(1) shl 34) - j; if (i <> (int64(1) shl 33)) then result := false; i := 1 - j; if (i <> (1-(int64(1) shl 33))) then result := false; i := 100000; i := i - 90000; if (i <> 10000) then result := false; if not result then Fail else WriteLn('Success.'); end; procedure int64TestMul; var i : int64; j : int64; k: int64; result: boolean; begin Write('int64 * int64 test...'); result := true; i:=0; j:=0; i:=i * 32; if i <> 0 then result := false; i:=10; i:=i * -16; if i <> -160 then result := false; j:=10000; i:=-10000; i:=i * j; if i <> -100000000 then result := false; i:=1; j:=10; k:=16; i := i * j * k; if i <> 160 then result := false; i := 1; j := 10; k := 16; i := i * 10 * j * i * j * 16 * k; if i <> 256000 then result := false; if not result then Fail else WriteLn('Success.'); end; procedure int64TestXor; var i, j : int64; result : boolean; begin Write('int64 XOR int64 test...'); result := true; i := 0; j := 0; i := i xor $1000001; if i <> $1000001 then result := false; i:=0; j:=$10000001; i:=i xor j; if i <> $10000001 then result := false; i := 0; j := $55555555; i := i xor j xor $AAAAAAAA; if i <> $FFFFFFFF then result := false; if not result then Fail else WriteLn('Success.'); end; procedure int64TestOr; var i,j : int64; result : boolean; Begin Write('int64 OR int64 test...'); result := true; i := 0; j := 0; i := i or $1000001; if i <> $1000001 then result := false; i:=0; j:=$10000001; i:=i or j; if i <> $10000001 then result := false; i := 0; j := $55555555; i := i or j or $AAAAAAAA; if i <> $FFFFFFFF then result := false; if not result then Fail else WriteLn('Success.'); end; procedure int64TestAnd; var i,j : int64; result : boolean; Begin Write('int64 AND int64 test...'); result := true; i := $1000001; j := 0; i := i and $1000001; if i <> $1000001 then result := false; i:=0; j:=$10000001; i:=i and j; if i <> 0 then result := false; i := $FFFFFFFF; j := $55555555; i := i and j; if i <> $55555555 then result := false; i := $FFFFFFFF; i := i and $AAAAAAAA; if i <> $AAAAAAAA then result := false; i := 0; j := $55555555; i := i and j and $AAAAAAAA; if i <> 0 then result := false; if not result then Fail else WriteLn('Success.'); end; procedure int64TestEqual; var i,j : int64; result : boolean; Begin Write('int64 = int64 test...'); result := true; i := $1000001; j := 0; if i = 0 then result := false; if i = j then result := false; if j = i then result := false; if not result then Fail else WriteLn('Success.'); end; procedure int64TestNotEqual; var i,j : int64; result : boolean; Begin Write('int64 <> int64 test...'); result := true; i := $1000001; j := $1000001; if i <> $1000001 then result := false; if i <> j then result := false; if j <> i then result := false; if not result then Fail else WriteLn('Success.'); end; procedure int64TestLE; var i, j: int64; result : boolean; begin Write('int64 <= int64 test...'); result := true; i := -1; j := -2; if i <= j then result := false; i := -2; j := $FFFF; if i >= j then result := false; i := $FFFFFFFF; if i <= $FFFFFFFE then result := false; j := $FFFFFFFF; if i <= j then begin if result then WriteLn('Success.') else Fail; end else Fail; end; procedure int64TestGE; var i, j: int64; result : boolean; begin Write('int64 >= int64 test...'); result := true; i := $FFFFFFFE; j := $FFFFFFFF; if i >= j then result := false; i := $FFFFFFFE; j := $FFFFFFFF; if i > j then result := false; i := $FFFFFFFE; if i > $FFFFFFFE then result := false; i := $FFFFFFFF; j := $FFFFFFFF; if i >= j then begin if result then WriteLn('Success.') else Fail; end else Fail; end; { QWord testing } procedure qwordTestAdd; var i: qword; j: qword; result : boolean; begin Write('qword + qword test...'); result := true; i:=0; j:=0; i := i + 10000; if i <> 10000 then result := false; j := 32767; i := i + j; if i <> 42767 then result := false; i := i + j + 50000; if i <> 125534 then result := false; i:=0; j:=10000; i:= i + j + j + i + j; if i <> 30000 then result := false; if not result then Fail else WriteLn('Success.'); end; procedure QwordTestSub; var i, j, k : qword; result : boolean; begin Write('qword - qword test...'); result := true; i:=100000; j:=54; k:=56; i:= i - 100; if i <> 99900 then result := false; i := i - j - k - 100; if i <> 99690 then result := false; i:=100; j:=1000; k:=100; i:= j - i - k; if i <> 800 then result := false; j := 900 - i; if (j <> 100) then result := false; i := 1000000000; k := i; i := i * 10; { The next statement would create an overflow } {$Q-} j := 1000000000 - i; k := k - i; if j <> k then result := false; { Since qword variable<>negative constant is always false according to the compiler (allowing it to optimize the if away) we need to do a preventive typecast to qword.} if j <> qword(1000000000-(qword(1000000000) * 10)) then result := false; j := (qword(1) shl 33); i := (qword(1) shl 34) - j; if (i <> (qword(1) shl 33)) then result := false; i := 1 - j; { Since qword variable<>negative constant is always false according to the compiler (allowing it to optimize the if away) we need to do a preventive typecast to qword.} if i <> qword(1-(qword(1) shl 33)) then result := false; i := 100000; i := i - 90000; if (i <> 10000) then result := false; if not result then Fail else WriteLn('Success.'); end; procedure QwordTestMul; var i : qword; j : qword; k: qword; result: boolean; begin Write('qword * qword test...'); result := true; i:=0; j:=0; i:=i * 32; if i <> 0 then result := false; i:=10; i:=i * 16; if i <> 160 then result := false; j:=10000; i:=10000; i:=i * j; if i <> 100000000 then result := false; i:=1; j:=10; k:=16; i := i * j * k; if i <> 160 then result := false; i := 1; j := 10; k := 16; i := i * 10 * j * i * j * 16 * k; if i <> 256000 then result := false; if not result then Fail else WriteLn('Success.'); end; procedure QwordTestXor; var i, j : qword; result : boolean; begin Write('qword XOR qword test...'); result := true; i := 0; j := 0; i := i xor $1000001; if i <> $1000001 then result := false; i:=0; j:=$10000001; i:=i xor j; if i <> $10000001 then result := false; i := 0; j := $55555555; i := i xor j xor $AAAAAAAA; if i <> $FFFFFFFF then result := false; if not result then Fail else WriteLn('Success.'); end; procedure QwordTestOr; var i,j : qword; result : boolean; Begin Write('qword OR qword test...'); result := true; i := 0; j := 0; i := i or $1000001; if i <> $1000001 then result := false; i:=0; j:=$10000001; i:=i or j; if i <> $10000001 then result := false; i := 0; j := $55555555; i := i or j or $AAAAAAAA; if i <> $FFFFFFFF then result := false; if not result then Fail else WriteLn('Success.'); end; procedure QwordTestAnd; var i,j : qword; result : boolean; Begin Write('qword AND qword test...'); result := true; i := $1000001; j := 0; i := i and $1000001; if i <> $1000001 then result := false; i:=0; j:=$10000001; i:=i and j; if i <> 0 then result := false; i := $FFFFFFFF; j := $55555555; i := i and j; if i <> $55555555 then result := false; i := $FFFFFFFF; i := i and $AAAAAAAA; if i <> $AAAAAAAA then result := false; i := 0; j := $55555555; i := i and j and $AAAAAAAA; if i <> 0 then result := false; if not result then Fail else WriteLn('Success.'); end; procedure QwordTestEqual; var i,j : qword; result : boolean; Begin Write('qword = qword test...'); result := true; i := $1000001; j := 0; if i = 0 then result := false; if i = j then result := false; if j = i then result := false; if not result then Fail else WriteLn('Success.'); end; procedure QwordTestNotEqual; var i,j : qword; result : boolean; Begin Write('qword <> qword test...'); result := true; i := $1000001; j := $1000001; if i <> $1000001 then result := false; if i <> j then result := false; if j <> i then result := false; if not result then Fail else WriteLn('Success.'); end; procedure QwordTestLE; var i, j: qword; result : boolean; begin Write('qword <= qword test...'); result := true; i := 1; j := 2; if j <= i then result := false; i := 2; j := $FFFF; if i >= j then result := false; i := $FFFFFFFF; if i <= $FFFFFFFE then result := false; j := $FFFFFFFF; if i <= j then begin if result then WriteLn('Success.') else Fail; end else Fail; end; procedure QwordTestGE; var i, j: qword; result : boolean; begin Write('qword >= qword test...'); result := true; i := $FFFFFFFE; j := $FFFFFFFF; if i >= j then result := false; i := $FFFFFFFE; j := $FFFFFFFF; if i > j then result := false; i := $FFFFFFFE; if i > $FFFFFFFE then result := false; i := $FFFFFFFF; j := $FFFFFFFF; if i >= j then begin if result then WriteLn('Success.') else Fail; end else Fail; end; Begin { These should be tested first, since if they do not } { work, they will false all other results. } Int64TestEqual; Int64TestNotEqual; Int64TestAdd; Int64TestMul; Int64TestOr; Int64TestAnd; Int64TestXor; Int64TestLe; Int64TestGe; Int64TestSub; QwordTestEqual; QwordTestNotEqual; QwordTestAdd; QwordTestMul; QwordTestOr; QwordTestAnd; QwordTestXor; QwordTestLe; QwordTestGe; QwordTestSub; end.