mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 19:29:24 +02:00
* must more 64-bit testing (to detect endian specific problems)
This commit is contained in:
carl
parent
1c0dc0a879
commit
10278b42e6
@ -346,6 +346,340 @@ begin
|
||||
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;
|
||||
j := 1000000000 - i;
|
||||
k := k - i;
|
||||
if j <> k then
|
||||
result := false;
|
||||
if j <> (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;
|
||||
if (i <> (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
|
||||
@ -361,12 +695,25 @@ Begin
|
||||
Int64TestLe;
|
||||
Int64TestGe;
|
||||
Int64TestSub;
|
||||
QwordTestEqual;
|
||||
QwordTestNotEqual;
|
||||
QwordTestAdd;
|
||||
QwordTestMul;
|
||||
QwordTestOr;
|
||||
QwordTestAnd;
|
||||
QwordTestXor;
|
||||
QwordTestLe;
|
||||
QwordTestGe;
|
||||
QwordTestSub;
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 2002-09-08 20:29:36 jonas
|
||||
Revision 1.7 2002-09-29 14:37:22 carl
|
||||
* must more 64-bit testing (to detect endian specific problems)
|
||||
|
||||
Revision 1.6 2002/09/08 20:29:36 jonas
|
||||
* some extra int64 - int64 tests for RISC processors
|
||||
|
||||
Revision 1.5 2002/09/07 15:40:49 peter
|
||||
|
||||
@ -169,13 +169,15 @@ procedure TestCmpListTwoInt64;
|
||||
procedure TestCmpListThreeInt64;
|
||||
var
|
||||
s: int64;
|
||||
l : longint;
|
||||
failed :boolean;
|
||||
begin
|
||||
Write('Linear Comparison list without ranges (int64)...');
|
||||
s := (3000000 shl 32);
|
||||
Write('Linear Comparison list without ranges (int64)...');
|
||||
l:=1;
|
||||
s := (int64(l) shl 32);
|
||||
failed := true;
|
||||
case s of
|
||||
(3000000 shl 32) : failed := false;
|
||||
(int64(3000000) shl 32) : failed := false;
|
||||
10 : ;
|
||||
3 : ;
|
||||
end;
|
||||
@ -356,7 +358,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2002-09-07 15:40:55 peter
|
||||
Revision 1.3 2002-09-29 14:37:22 carl
|
||||
* must more 64-bit testing (to detect endian specific problems)
|
||||
|
||||
Revision 1.2 2002/09/07 15:40:55 peter
|
||||
* old logs removed and tabs fixed
|
||||
|
||||
Revision 1.1 2002/07/28 09:45:24 carl
|
||||
|
||||
@ -48,7 +48,7 @@ var
|
||||
i: longint;
|
||||
begin
|
||||
i:=1;
|
||||
getint64_2 := i shl 36;
|
||||
getint64_2 := int64(i) shl 36;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
@ -118,7 +118,7 @@ begin
|
||||
Test('int64 -> longbool : Value should be TRUE...',lb1);
|
||||
{ does it indirectly, since it might not work in direct mode }
|
||||
value:=1;
|
||||
fromint64 := value shl 36 ;
|
||||
fromint64 := int64(value) shl int64(36) ;
|
||||
lb1 := longbool(fromint64);
|
||||
Test('int64 -> longbool : Value should be TRUE...',lb1);
|
||||
{$endif}
|
||||
@ -200,7 +200,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2002-09-27 17:46:01 carl
|
||||
Revision 1.6 2002-09-29 14:37:22 carl
|
||||
* must more 64-bit testing (to detect endian specific problems)
|
||||
|
||||
Revision 1.5 2002/09/27 17:46:01 carl
|
||||
+ big-endian testing
|
||||
|
||||
Revision 1.4 2002/09/07 15:40:55 peter
|
||||
|
||||
@ -6,6 +6,7 @@
|
||||
{ PRE-REQUISITES: secondload() }
|
||||
{ secondassign() }
|
||||
{ secondtypeconv() }
|
||||
{ secondshlshr() }
|
||||
{****************************************************************}
|
||||
{ DEFINES: }
|
||||
{ FPC = Target is FreePascal compiler }
|
||||
@ -46,6 +47,15 @@ function getint64cnt: int64;
|
||||
getint64cnt := -10;
|
||||
end;
|
||||
|
||||
function getint64cnt_2 : int64;
|
||||
var
|
||||
longval : longint;
|
||||
begin
|
||||
longval := 1;
|
||||
getint64cnt_2 := int64(longval) shl 33;
|
||||
end;
|
||||
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
procedure test(value, required: longint);
|
||||
@ -67,6 +77,7 @@ var
|
||||
cardinalcnt : cardinal;
|
||||
int64res : int64;
|
||||
int64cnt : int64;
|
||||
longval : longint;
|
||||
{$ENDIF}
|
||||
begin
|
||||
WriteLn('------------------- LONGINT ------------------------');
|
||||
@ -241,33 +252,6 @@ begin
|
||||
test(cardinalres, 1);
|
||||
|
||||
WriteLn('--------------------- INT64 ------------------------');
|
||||
{ special tests for results }
|
||||
Writeln('special numeric values tests...');
|
||||
int64res := $7FFFFFFF shl 32;
|
||||
int64cnt := $80000000 shl 32;
|
||||
int64res := int64res div int64cnt;
|
||||
Write('Value should be 0...');
|
||||
test(int64res and $FFFFFFFF, 0);
|
||||
|
||||
Writeln('special numeric values tests...');
|
||||
int64res := $7FFFFFFF shl 32;
|
||||
int64cnt := $80000000 shl 32;
|
||||
int64res := int64cnt div int64res;
|
||||
Write('Value should be -1...');
|
||||
test(int64res and $FFFFFFFF, -1);
|
||||
|
||||
int64res := $7FFFFFFF;
|
||||
int64cnt := $80000000;
|
||||
int64res := int64res div int64cnt;
|
||||
Write('Value should be 0...');
|
||||
test(int64res and $FFFFFFFF, 0);
|
||||
|
||||
Writeln('special numeric values tests...');
|
||||
int64res := $7FFFFFFF;
|
||||
int64cnt := $80000000;
|
||||
int64res := int64cnt div int64res;
|
||||
Write('Value should be 1...');
|
||||
test(int64res and $FFFFFFFF, 1);
|
||||
|
||||
WriteLn('(left) : LOC_REFERENCE; (right) : ordinal constant');
|
||||
{ RIGHT : power of 2 ordconstn }
|
||||
@ -294,6 +278,17 @@ begin
|
||||
Write('Value should be -10...');
|
||||
test(int64res and $FFFFFFFF, -10);
|
||||
|
||||
|
||||
{ RIGHT : LOC_REFERENCE }
|
||||
{ LEFT : LOC_REFERENCE }
|
||||
longval := 1;
|
||||
int64res := int64(longval) shl 33;
|
||||
int64cnt := 100;
|
||||
int64res := int64res div int64cnt;
|
||||
Write('Value should be 85899345...');
|
||||
test(int64res and $FFFFFFFF, 85899345);
|
||||
|
||||
|
||||
{ RIGHT : LOC_REFERENCE }
|
||||
{ LEFT : LOC_REFERENCE }
|
||||
int64res := 10101010;
|
||||
@ -330,6 +325,42 @@ begin
|
||||
int64res := getint64cnt mod int64cnt;
|
||||
Write('Value should be -1...');
|
||||
test(int64res and $FFFFFFFF, -1);
|
||||
|
||||
{ RIGHT : LOC_REFERENCE }
|
||||
{ LEFT : LOC_REGISTER }
|
||||
int64cnt := 100;
|
||||
int64res := getint64cnt_2 div int64cnt;
|
||||
Write('Value should be 85899345...');
|
||||
test(int64res and $FFFFFFFF, 85899345);
|
||||
|
||||
{ SPECIAL-------------------------------------------------}
|
||||
{ special tests for results }
|
||||
Writeln('special numeric values tests...');
|
||||
int64res := $7FFFFFFF shl 32;
|
||||
int64cnt := $80000000 shl 32;
|
||||
int64res := int64res div int64cnt;
|
||||
Write('Value should be 0...');
|
||||
test(int64res and $FFFFFFFF, 0);
|
||||
|
||||
Writeln('special numeric values tests...');
|
||||
int64res := int64($7FFFFFFF) shl 32;
|
||||
int64cnt := int64($80000000) shl 32;
|
||||
int64res := int64cnt div int64res;
|
||||
Write('Value should be -1...');
|
||||
test(int64res and $FFFFFFFF, -1);
|
||||
|
||||
int64res := $7FFFFFFF;
|
||||
int64cnt := $80000000;
|
||||
int64res := int64res div int64cnt;
|
||||
Write('Value should be 0...');
|
||||
test(int64res and $FFFFFFFF, 0);
|
||||
|
||||
Writeln('special numeric values tests...');
|
||||
int64res := $7FFFFFFF;
|
||||
int64cnt := $80000000;
|
||||
int64res := int64cnt div int64res;
|
||||
Write('Value should be 1...');
|
||||
test(int64res and $FFFFFFFF, 1);
|
||||
|
||||
{$ENDIF}
|
||||
end.
|
||||
|
||||
@ -5,6 +5,22 @@
|
||||
{$define HASWIDESTR}
|
||||
{$endif VER1_0}
|
||||
|
||||
function getint64_1 : int64;
|
||||
var
|
||||
value : longint;
|
||||
begin
|
||||
value:=1;
|
||||
getint64_1 := int64(value) shl 40;
|
||||
end;
|
||||
|
||||
function getint64_2 : int64;
|
||||
var
|
||||
value : longint;
|
||||
begin
|
||||
value:=65535;
|
||||
getint64_2 := value;
|
||||
end;
|
||||
|
||||
procedure test_rwtext;
|
||||
var
|
||||
t: text;
|
||||
@ -21,6 +37,9 @@ var
|
||||
arr: array[1..10] of char;
|
||||
p: pchar;
|
||||
r: real;
|
||||
vl : int64;
|
||||
vl1 : int64;
|
||||
tmplong : longint;
|
||||
begin
|
||||
bool := true;
|
||||
writeln('ShortString const test');
|
||||
@ -46,6 +65,10 @@ begin
|
||||
|
||||
a := 'this is an ansistring';
|
||||
writeln(a);
|
||||
|
||||
vl:=getint64_1;
|
||||
vl1:=getint64_2;
|
||||
writeln('int64 test : ',vl, ' ',vl1);
|
||||
|
||||
{$ifdef HASWIDESTR}
|
||||
wc := 'y';
|
||||
@ -66,9 +89,13 @@ begin
|
||||
writeln(t,l);
|
||||
writeln(t,c);
|
||||
writeln(t,b);
|
||||
writeln(t,vl);
|
||||
writeln(t,vl1);
|
||||
l := 0;
|
||||
c := #32;
|
||||
b := 5;
|
||||
vl:=1;
|
||||
vl1 := 2;
|
||||
close(t);
|
||||
reset(t);
|
||||
readln(t,s);
|
||||
@ -83,6 +110,13 @@ begin
|
||||
readln(t,b);
|
||||
if b <> 60 then
|
||||
halt(1);
|
||||
{ 64-bit read testing }
|
||||
readln(t,vl);
|
||||
if vl <> getint64_1 then
|
||||
halt(1);
|
||||
readln(t,vl1);
|
||||
if vl1 <> getint64_2 then
|
||||
halt(1);
|
||||
close(t);
|
||||
erase(t);
|
||||
writeln('write/read text passed...');
|
||||
|
||||
@ -39,6 +39,17 @@ begin
|
||||
writeln('Passed!');
|
||||
end;
|
||||
|
||||
type
|
||||
tint64record = packed record
|
||||
{$ifdef ENDIAN_BIG}
|
||||
highval : longint;
|
||||
lowval : longint;
|
||||
{$else}
|
||||
lowval : longint;
|
||||
highval : longint;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
longres : longint;
|
||||
@ -48,6 +59,7 @@ var
|
||||
{$IFDEF FPC}
|
||||
int64res : int64;
|
||||
int64cnt : int64;
|
||||
int64rec : tint64record;
|
||||
{$ENDIF}
|
||||
Begin
|
||||
WriteLn('------------------------------ LONGINT --------------------------------');
|
||||
@ -203,9 +215,6 @@ Begin
|
||||
Write('(SHR) Value should be 1...');
|
||||
test(int64res and $FFFFFFFF, 1);
|
||||
|
||||
{ int64res:=-1;
|
||||
int64res := int64res shr 15;
|
||||
Write('(SHR) Value should be 131071...');}
|
||||
int64res:=$FFFF;
|
||||
int64res := int64res shr 65;
|
||||
Write('(SHR) Value should be 0...');
|
||||
@ -232,6 +241,14 @@ Begin
|
||||
int64res := int64res shl int64cnt;
|
||||
Write('(SHL) Value should be -32768...');
|
||||
test(int64res and $FFFFFFFF, -32768);
|
||||
|
||||
int64res := 1;
|
||||
int64cnt := 33;
|
||||
int64res := int64res shl int64cnt;
|
||||
Write('(SHL) Value should be 2 in high longint (85899345)...');
|
||||
move(int64res,int64rec, sizeof(int64));
|
||||
test(int64rec.highval, 2);
|
||||
{ test(int64res, 8589934592);}
|
||||
|
||||
|
||||
int64res := 1;
|
||||
@ -288,6 +305,14 @@ Begin
|
||||
int64res := int64res shr bytecnt;
|
||||
Write('(SHR) Value should be 1...');
|
||||
test(int64res and $FFFFFFFF, 1);
|
||||
|
||||
int64res := 1;
|
||||
bytecnt := 33;
|
||||
int64res := int64res shl bytecnt;
|
||||
Write('(SHL) Value should be 2 in high longint (85899345)...');
|
||||
move(int64res,int64rec, sizeof(int64));
|
||||
test(int64rec.highval, 2);
|
||||
|
||||
{ int64res:=-1;
|
||||
bytecnt := 15;
|
||||
int64res := int64res shr bytecnt;
|
||||
@ -298,7 +323,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2002-09-07 15:40:56 peter
|
||||
Revision 1.6 2002-09-29 14:37:22 carl
|
||||
* must more 64-bit testing (to detect endian specific problems)
|
||||
|
||||
Revision 1.5 2002/09/07 15:40:56 peter
|
||||
* old logs removed and tabs fixed
|
||||
|
||||
Revision 1.4 2002/03/29 18:43:55 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user