* must more 64-bit testing (to detect endian specific problems)

tests/test/cg/tadint64.pp

@@ -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

tests/test/cg/tcase.pp

@@ -169,13 +169,15 @@ procedure TestCmpListTwoInt64;
  procedure TestCmpListThreeInt64;
   var
    s: int64;
+   l : longint;
    failed :boolean;
   begin
-   Write('Linear Comparison list without ranges (int64)...');
+    Write('Linear Comparison list without ranges (int64)...');
-    s := (3000000 shl 32);
+    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

tests/test/cg/tcnvint2.pp

@@ -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

tests/test/cg/tmoddiv.pp

@@ -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.

tests/test/cg/treadwrt.pp

@@ -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...');

tests/test/cg/tshlshr.pp

@@ -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