Test suite results for test file test/tint642.pp

Test run data :

Test file "test/tint642.pp" information:

t_id 52
t_adddate 2003/10/03
t_result 0
t_knownrunerror 0

Detailed test run results:

Record count: 1

Log of 935006:

------------------------------------------------------
                    QWord test 
------------------------------------------------------

Testing assignqword and dumpqword ... 
$12345678 9ABCDEF0
The output should be:
$12345678 9ABCDEF0

Testing simple QWord comparisations
  <>,= succesfully tested
  <,> succesfully tested
  >=,<= succesfully tested
  More comparisations successful tested
Testing simple QWord comparisations was successful

Testing QWord additions
Testing QWord additions was successful

Testing more QWord comparisations
Testing more QWord comparisations was successful

Testing QWord subtraction
Testing QWord subtraction was successful

Testing QWord constants
Testing QWord constants was successful

Testing QWord logical operators (or,xor,and)
Testing QWord logical operators (or,xor,and) was successful

Testing QWord logical not operator
Testing QWord logical not operator was successful

Testing QWord logical - operator
Testing QWord logical - operator was successful

Testing QWord logical shift operators (shr,shr)
Testing QWord logical shift operators (shr,shr) was successful

Testing QWord function results
Testing QWord function results was successful

Testing QWord type casts
Testing QWord type casts was successful

Testing QWord internal procedures
Testing QWord internal procedures was successful

Testing QWord multiplications
Doing some random multiplications (100000 iterations), takes a few seconds
........................................ 100%
........................................ OK
Testing QWord multiplications was successful

Testing QWord division
Doing some random divisions (100000 iterations), takes a few seconds
.................... 100%
.................... OK
Testing QWord division was successful

Testing QWord modulo divisiqemu: unhandled CPU exception 0x15 - aborting
Failing executable: ./tint642
pc=0x00406958 HI=0x00000000 LO=0x0000000a ds 00a2 00406924 0
GPR00: r0 00000000 at fffffff8 v0 00000000 v1 00000000
GPR04: a0 ffffffff a1 00000001 a2 80000000 a3 00000000
GPR08: t0 00000001 t1 00000003 t2 00000000 t3 00000000
GPR12: t4 00000000 t5 00000000 t6 00000000 t7 00000000
GPR16: s0 0052baec s1 00000000 s2 00000000 s3 00000000
GPR20: s4 00000000 s5 00000000 s6 00000000 s7 00000000
GPR24: t8 00000000 t9 00409f74 k0 00000000 k1 00000000
GPR28: gp 00531580 sp 407fff60 s8 408000e0 ra 00406924
CP0 Status  0x20000010 Cause   0x00000000 EPC    0x00000000
    Config0 0x80000482 Config1 0x9e190c8f LLAddr 0x0000000000000000
    Config2 0x80000000 Config3 0x00000000
    Config4 0x00000000 Config5 0x00000000
400000-4f6000 r-xp 00000000 fe:01 14351925                               /home/muller/pas/gitlab-fpc-source/tests/output/mipsel-linux/test/chunk000000015test/tint642
4f6000-506000 ---p 00000000 00:00 0                                      
506000-52c000 rw-p 000f6000 fe:01 14351925                               /home/muller/pas/gitlab-fpc-source/tests/output/mipsel-linux/test/chunk000000015test/tint642
52c000-52e000 rw-p 00000000 00:00 0                                      
3ffef000-3ffff000 rw-p 00000000 00:00 0                                  
3ffff000-40000000 r-xp 00000000 00:00 0                                  
40000000-40001000 ---p 00000000 00:00 0                                  
40001000-40801000 rw-p 00000000 00:00 0                                  [stack]
**
ERROR:../qemu-7.2.0/accel/tcg/cpu-exec.c:954:cpu_exec: assertion failed: (cpu == current_cpu)
Bail out! ERROR:../qemu-7.2.0/accel/tcg/cpu-exec.c:954:cpu_exec: assertion failed: (cpu == current_cpu)

Source:

{$Q-} { this is necessary to avoid an overflow error below }
{$mode objfpc}
uses
   sysutils
{$ifdef go32v2}
   ,dpmiexcp
{$endif go32v2}
   ;
type
   tqwordrec = packed record
{$ifndef ENDIAN_BIG}   
      low,high : dword;
{$else}
      high, low : dword;
{$endif}      
   end;

procedure dumpqword(q : qword);

  begin
     write('$',hexstr(tqwordrec(q).high,8),' ',hexstr(tqwordrec(q).low,8));
  end;

procedure dumpqwordln(q : qword);

  begin
     dumpqword(q);
     writeln;
  end;

procedure assignqword(h,l : dword;var q : qword);

  begin
     tqwordrec(q).high:=h;
     tqwordrec(q).low:=l;
  end;

procedure do_error(l : longint);

  begin
     writeln('Error near number ',l);
     halt(1);
  end;

procedure do_error;

  begin
     do_error(0);
  end;

procedure simpletestcmpqword;

  var
     q1,q2,q3,q4 : qword;

  begin
     assignqword(0,5,q1);
     assignqword(6,0,q2);
     assignqword(6,1,q3);
     assignqword(6,5,q4);
     { first test the code generation of the operators }
     if q1<>q1 then
       do_error(0);
     if q2<>q2 then
       do_error(0);
     if q3<>q3 then
       do_error(0);
     if not(q1=q1) then
       do_error(0);
     if not(q2=q2) then
       do_error(0);
     if not(q3=q3) then
       do_error(0);
     writeln('  <>,= succesfully tested');

     if q1>q2 then
       do_error(1100);
     if q2>q3 then
       do_error(1101);
     if q2 succesfully tested');

     if q1>=q2 then
       do_error(1104);
     if q2>=q3 then
       do_error(1105);
     if q2<=q1 then
       do_error(1106);
     if q3<=q2 then
       do_error(1107);
     writeln('  >=,<= succesfully tested');

     if q1=q2 then
       do_error(1108);
     if q2=q3 then
       do_error(1109);
     if q3=q1 then
       do_error(1111);

     if q1=q4 then
       do_error(1112);
     if q2=q4 then
       do_error(1113);
     if q3=q4 then
       do_error(1114);
     writeln('  More comparisations successful tested');
  end;

procedure testaddqword;

  var
     q1,q2,q3,q4,q5,q6 : qword;

  begin
     { without overflow between 32 bit }
     assignqword(0,5,q1);
     assignqword(0,6,q2);
     assignqword(0,1,q3);
     assignqword(0,11,q4);
     assignqword(0,1,q5);
     if q1+q2<>q4 then
       do_error(1200);
     if q1+q3+q1<>q4 then
       do_error(1201);
     if q1+(q3+q1)<>q4 then
       do_error(1202);
     if (q1+q3)+q1<>q4 then
       do_error(1203);
     { a more complex expression }
     if ((((q5+q3)+(q3+q5))+((q5+q3)+(q3+q5)))+q5+q3+q5)<>q4 then
       do_error(1204);
     { with overflow between 32 bit }
     assignqword(0,$ffffffff,q1);
     assignqword(1,3,q2);
     assignqword(0,4,q3);
     assignqword(1,4,q4);
     assignqword(0,1,q5);
     assignqword(1,$fffffffe,q6);
     if q1+q3<>q2 then
       do_error(1205);
     if q3+q1<>q2 then
       do_error(1206);
     if q1+(q3+q5)<>q4 then
       do_error(1207);
     if (q1+q3)+q5<>q4 then
       do_error(1208);
     if (q1+q1)<>q6 then
       do_error(1209);
  end;

procedure testcmpqword;

  var
     q1,q2,q3,q4,q5,q6 : qword;

  begin
     assignqword(0,$ffffffff,q1);
     assignqword(0,$ffffffff,q2);
     assignqword(1,$fffffffe,q3);
     assignqword(0,2,q4);
     assignqword(1,$fffffffc,q5);
     if (q1+q2)<>q3 then
       do_error(1300);
     if not(q3=(q1+q2)) then
       do_error(1301);
     if (q1+q2)>q3 then
       do_error(1302);
     if (q1+q2)=(q1+q2)) then
       do_error(1305);

     if (q1+q2)<>(q4+q5) then
       do_error(1306);
     if not((q4+q5)=(q1+q2)) then
       do_error(1307);
     if (q1+q2)>(q4+q5) then
       do_error(1308);
     if (q1+q2)<(q4+q5) then
       do_error(1309);
     if not((q4+q5)<=(q1+q2)) then
       do_error(1310);
     if not((q4+q5)>=(q1+q2)) then
       do_error(1311);
  end;

procedure testlogqword;

  var
     q0,q1,q2,q3,q4,q5,q6 : qword;

  begin
     assignqword(0,0,q0);
     assignqword($ffffffff,$ffffffff,q1);
     assignqword(0,$ffffffff,q2);
     assignqword($ffffffff,0,q3);
     assignqword($a0a0a0a0,$50505050,q4);
     assignqword(0,$50505050,q5);
     assignqword($a0a0a0a0,0,q6);

     { here we don't need to test all cases of locations, }
     { this is already done by the addtion test           }
     if (q2 or q3)<>q1 then
       do_error(1400);
     if (q5 or q6)<>q4 then
       do_error(1401);

     if (q2 and q3)<>q0 then
       do_error(1402);
     if (q5 and q6)<>q0 then
       do_error(1403);

     if (q2 xor q3)<>q1 then
       do_error(1404);
     if (q5 xor q6)<>q4 then
       do_error(1405);
     { the test before could be also passed by the or operator! }
     if (q4 xor q4)<>q0 then
       do_error(1406);
  end;

procedure testshlshrqword;

  var
     q0,q1,q2,q3,q4,q5 : qword;
     l1,l2 : longint;

  begin
     assignqword(0,0,q0);
     assignqword($ffff,$ffff0000,q1);
     assignqword(0,$ffffffff,q2);
     assignqword($ffffffff,0,q3);
     assignqword(0,1,q4);
     assignqword($80000000,0,q5);

     l1:=16;
     l2:=0;
     if (q1 shl 16)<>q3 then
       do_error(1500);
     if (q1 shl 48)<>q0 then
       do_error(1501);
     if (q1 shl 47)<>q5 then
       do_error(1501);
     if ((q1+q0) shl 16)<>q3 then
       do_error(1502);
     if ((q1+q0) shl 48)<>q0 then
       do_error(1503);
     if ((q1+q0) shl 47)<>q5 then
       do_error(15031);

     if (q1 shl l1)<>q3 then
       do_error(1504);
     if (q1 shl (3*l1))<>q0 then
       do_error(1505);
     if ((q1+q0) shl l1)<>q3 then
       do_error(1506);
     if ((q1+q0) shl (3*l1))<>q0 then
       do_error(1507);
     if ((q1+q0) shl (3*l1-1))<>q5 then
       do_error(15071);

     if (q1 shl (l1+l2))<>q3 then
       do_error(1508);
     if ((q1+q0) shl (l1+l2))<>q3 then
       do_error(1509);

     if (q1 shr 16)<>q2 then
       do_error(1510);
     if (q1 shr 48)<>q0 then
       do_error(1511);
     if (q1 shr 47)<>q4 then
       do_error(15111);

     if ((q1+q0) shr 16)<>q2 then
       do_error(1512);
     if ((q1+q0) shr 48)<>q0 then
       do_error(1513);
     if (q1 shr l1)<>q2 then
       do_error(1514);
     if (q1 shr (3*l1))<>q0 then
       do_error(1515);
     if (q1 shr (3*l1-1))<>q4 then
       do_error(15151);

     if ((q1+q0) shr l1)<>q2 then
       do_error(1516);
     if ((q1+q0) shr (3*l1))<>q0 then
       do_error(1517);
     if ((q1+q0) shr (3*l1-1))<>q4 then
       do_error(15171);

     if (q1 shr (l1+l2))<>q2 then
       do_error(1518);
     if ((q1+q0) shr (l1+l2))<>q2 then
       do_error(1519);
  end;

procedure testsubqword;

  var
     q0,q1,q2,q3,q4,q5,q6 : qword;

  begin
     { without overflow between 32 bit }
     assignqword(0,0,q0);
     assignqword(0,6,q1);
     assignqword(0,5,q2);
     assignqword(0,1,q3);
     assignqword(0,11,q4);
     assignqword(0,1,q5);
     if q1-q2<>q3 then
       do_error(1600);
     if q1-q0-q1<>q0 then
       do_error(1601);
     if q1-(q0-q1)<>q1+q1 then
       do_error(1602);
     if (q1-q0)-q1<>q0 then
       do_error(1603);

     { a more complex expression }
     if ((((q5-q3)-(q3-q5))-((q5-q3)-(q3-q5))))<>q0 then
       do_error(1604);

     { with overflow between 32 bit }
     assignqword(1,0,q1);
     assignqword(0,$ffffffff,q2);
     assignqword(0,1,q3);
     assignqword(1,$ffffffff,q4);

     if q1-q2<>q3 then
       do_error(1605);
     if q1-q0-q2<>q3 then
       do_error(1606);
     if q1-(q0-q2)<>q4 then
       do_error(1607);
     if (q1-q0)-q1<>q0 then
       do_error(1608);

     assignqword(1,$ffffffff,q5);
     assignqword(1,$ffffffff,q4);

     { a more complex expression }
     if ((((q5-q3)-(q3-q5))-((q5-q3)-(q3-q5))))<>q0 then
       do_error(1609);
  end;

procedure testnotqword;

  var
     q0,q1,q2,q3,q4 : qword;

  begin
     assignqword($f0f0f0f0,$f0f0f0f0,q1);
     assignqword($f0f0f0f,$f0f0f0f,q2);
     assignqword($f0f0f0f0,0,q3);
     assignqword(0,$f0f0f0f0,q4);
     if not(q1)<>q2 then
       do_error(1700);
     if not(q3 or q4)<>q2 then
       do_error(1701);

     { do a more complex expression to stress the register saving }
     if not(q3 or q4)<>not(q3 or q4) then
       do_error(1702);
  end;

procedure testnegqword;

  var
     q0,q1,q2,q3,q4 : qword;

  begin
     assignqword($1,$0,q1);
     assignqword($0,1234,q2);
     if -q1<>(0-q1) then
       do_error(2700);
     if -q2<>(0-q2) then
       do_error(2701);
     if -(q1+q2)<>(0-(q1+q2)) then
       do_error(2702);
  end;

procedure testmulqword;

  var
     q0,q1,q2,q3,q4,q5,q6 : qword;
     i : longint;

  begin
     assignqword(0,0,q0);
     assignqword(0,1,q1);
     assignqword(0,4,q2);
     assignqword(2,0,q3);
     assignqword(8,0,q4);
     assignqword(0,1,q5);
     assignqword($ffff,$12344321,q6);
     { to some trivial tests       }
     { to test the code generation }
     if q1*q2<>q2 then
       do_error(1800);
     if q1*q2*q3<>q4 then
       do_error(1801);
     if q1*(q2*q3)<>q4 then
       do_error(1802);
     if (q1*q2)*q3<>q4 then
       do_error(1803);
     if (q6*q5)*(q1*q2)<>q1*q2*q5*q6 then
       do_error(1804);

     { a more complex expression }
     if ((((q1*q5)*(q1*q5))*((q5*q1)*(q1*q5)))*q5*q1*q5)<>q1 then
       do_error(1805);

     { now test the multiplication procedure with random bit patterns }
     writeln('Doing some random multiplications, takes a few seconds');
     writeln('.....................................100%');
     for i:=1 to 1000000 do
       begin
          tqwordrec(q1).high:=0;
          tqwordrec(q1).low:=random($7ffffffe);
          tqwordrec(q2).high:=0;
          tqwordrec(q2).low:=random($7ffffffe);
          if q1*q2<>q2*q1 then
            begin
               write('Multiplication of ');
               dumpqword(q1);
               write(' and ');
               dumpqword(q2);
               writeln(' failed');
               do_error(1806);
            end;
          if i mod 50000=0 then
            write('.');
       end;
     for i:=1 to 1000000 do
       begin
          tqwordrec(q1).high:=0;
          tqwordrec(q1).low:=random($7ffffffe);
          q1:=q1 shl 16;
          tqwordrec(q2).high:=0;
          tqwordrec(q2).low:=random($fffe);
          if q1*q2<>q2*q1 then
            begin
               write('Multiplication of ');
               dumpqword(q1);
               write(' and ');
               dumpqword(q2);
               writeln(' failed');
               do_error(1806);
            end;
          if i mod 50000=0 then
            write('.');
       end;
     writeln(' OK');
  end;

procedure testdivqword;

  var
     q0,q1,q2,q3,q4,q5,q6 : qword;
     i : longint;

  begin
     assignqword(0,0,q0);
     assignqword(0,1,q1);
     assignqword(0,4,q2);
     assignqword(2,0,q3);
     assignqword(8,0,q4);
     assignqword(0,1,q5);
     assignqword($ffff,$12344321,q6);
     { to some trivial tests       }
     { to test the code generation }
     if q2 div q1<>q2 then
       do_error(1900);
     if q2 div q1 div q1<>q2 then
       do_error(1901);
     if q2 div (q4 div q3)<>q1 then
       do_error(1902);
     if (q4 div q3) div q2<>q1 then
       do_error(1903);

     { a more complex expression }
     if (q4 div q3) div (q2 div q1)<>(q2 div q1) div (q4 div q3) then
       do_error(1904);

     { now test the division procedure with random bit patterns }
     writeln('Doing some random divisions, takes a few seconds');
     writeln('.................100%');
     for i:=1 to 100000 do
       begin
          tqwordrec(q1).high:=random($7ffffffe);
          tqwordrec(q1).low:=random($7ffffffe);
          tqwordrec(q2).high:=random($7ffffffe);
          tqwordrec(q2).low:=random($7ffffffe);
          { avoid division by zero }
          if (tqwordrec(q2).low or tqwordrec(q2).high)=0 then
            tqwordrec(q2).low:=1;
          q3:=q1 div q2;
          { get a restless division }
          q1:=q2*q3;
          q3:=q1 div q2;
          if q3*q2<>q1 then
            begin
               write('Division of ');
               dumpqword(q1);
               write(' by ');
               dumpqword(q2);
               writeln(' failed');
               do_error(1906);
            end;
          if i mod 10000=0 then
            write('.');
       end;
     for i:=1 to 100000 do
       begin
          tqwordrec(q1).high:=0;
          tqwordrec(q1).low:=random($7ffffffe);
          tqwordrec(q2).high:=0;
          tqwordrec(q2).low:=random($7ffffffe);
          { avoid division by zero }
          if tqwordrec(q2).low=0 then
            tqwordrec(q2).low:=1;
          { get a restless division }
          q3:=q1*q2;
          q3:=q3 div q2;
          if q3<>q1 then
            begin
               write('Division of ');
               dumpqword(q1);
               write(' by ');
               dumpqword(q2);
               writeln(' failed');
               do_error(1907);
            end;
          if i mod 10000=0 then
            write('.');
       end;
     writeln(' OK');
  end;

function testf : qword;

  var
     q : qword;

  begin
     assignqword($ffffffff,$a0a0a0a0,q);
     testf:=q;
  end;

procedure testfuncqword;

  var
     q : qword;

  begin
     assignqword($ffffffff,$a0a0a0a0,q);
     if testf<>q then
       do_error(1900);
     if q<>testf then
       do_error(1901);
  end;

procedure testtypecastqword;

  var
     s1,s2 : shortint;
     b1,b2 : byte;
     w1,w2 : word;
     i1,i2 : integer;
     l1,l2 : longint;
     d1,d2 : dword;
     q1,q2 : qword;
     r1,r2 : double;

  begin
     { shortint }
     s1:=75;
     s2:=0;
     q1:=s1;
     { mix up the processor a little bit }
     q2:=q1;
     if q2<>75 then
       begin
          dumpqword(q2);
          do_error(2006);
       end;
     s2:=q2;
     if s1<>s2 then
       do_error(2000);

     { byte }
     b1:=$ca;
     b2:=0;
     q1:=b1;
     { mix up the processor a little bit }
     q2:=q1;
     if q2<>$ca then
       do_error(2007);
     b2:=q2;
     if b1<>b2 then
       do_error(2001);

     { integer }
     i1:=12345;
     i2:=0;
     q1:=i1;
     { mix up the processor a little bit }
     q2:=q1;
     if q2<>12345 then
       do_error(2008);
     i2:=q2;
     if i1<>i2 then
       do_error(2002);

     { word }
     w1:=$a0ff;
     w2:=0;
     q1:=w1;
     { mix up the processor a little bit }
     q2:=q1;
     if q2<>$a0ff then
       do_error(2009);
     w2:=q2;
     if w1<>w2 then
       do_error(2003);

     { longint }
     l1:=12341234;
     l2:=0;
     q1:=l1;
     { mix up the processor a little bit }
     q2:=q1;
     if q2<>12341234 then
       do_error(2010);
     l2:=q2;
     if l1<>l2 then
       do_error(2004);

     { dword }
     d1:=$5bcdef01;
     b2:=0;
     q1:=d1;
     { mix up the processor a little bit }
     q2:=q1;
     if q2<>$5bcdef01 then
       do_error(2011);
     d2:=q2;
     if d1<>d2 then
       do_error(2005);

     { real }
     { memory location }
     q1:=12;
     d1:=q1;
     d2:=12;
     if d1<>d2 then
       do_error(2012);

     { register location }
     q1:=12;
     d1:=q1+1;
     d2:=13;
     if d1<>d2 then
       do_error(2013);

     // a constant which can't be loaded with fild
     q1:=$80000000;
     q1:=q1 shl 32;
     d1:=q1;
     d2:=$80000000;
     if d1<>d2*d2*2.0 then
       do_error(20);
     // register location
     d1:=q1+1;
     if d1<>d2*d2*2.0+1 then
       do_error(2014);
  end;

procedure testioqword;

  var
     t : text;
     q1,q2 : qword;
     i : longint;

  begin
     assignqword($ffffffff,$a0a0a0a0,q1);
     assign(t,'testi642.tmp');
     rewrite(t);
     writeln(t,q1);
     close(t);
     reset(t);
     readln(t,q2);
     close(t);
     if q1<>q2 then
       do_error(2100);
     { do some random tests }
     for i:=1 to 100 do
       begin
          tqwordrec(q1).high:=random($7ffffffe);
          tqwordrec(q1).low:=random($7ffffffe);
          rewrite(t);
          writeln(t,q1);
          close(t);
          reset(t);
          readln(t,q2);
          close(t);
          if q1<>q2 then
            begin
               write('I/O of ');dumpqword(q1);writeln(' failed');
               do_error(2101);
            end;
       end;
  end;

procedure teststringqword;

  var
     q1,q2 : qword;
     s : string;
     l : longint;
     a : ansistring;
     code : integer;

  begin
     { testing str: shortstring }
     // simple tests
     q1:=1;
     str(q1,s);
     if s<>'1' then
       do_error(2200);
     // simple tests
     q1:=0;
     str(q1,s);
     if s<>'0' then
       do_error(2201);

     // more complex tests
     q1:=4321;
     str(q1,s);
     if s<>'4321' then
       do_error(2202);
     str(q1:6,s);
     if s<>'  4321' then
       do_error(2203);

     // create a big qword:
     q2:=1234;
     l:=1000000000;
     q2:=q2*l;
     l:=54321;
     q2:=q2+l;
     str(q2,s);
     if s<>'1234000054321' then
       do_error(2204);

     { testing str: ansistring }
     // more complex tests
     q1:=4321;
     str(q1,a);
     if a<>'4321' then
       do_error(2205);
     str(q1:6,a);
     if a<>'  4321' then
       do_error(2206);

     // create a big qword:
     q2:=1234;
     l:=1000000000;
     q2:=q2*l;
     l:=54321;
     q2:=q2+l;
     str(q2,a);
     if a<>'1234000054321' then
       do_error(2207);

     { testing val for qword }
     assignqword($ffffffff,$ffffffff,q1);
     s:='18446744073709551615';
     a:=s;
     val(s,q2,code);
     if code<>0 then
       do_error(2208);
     if q1<>q2 then
       do_error(2209);
     val(a,q2,code);
     if code<>0 then
       do_error(2210);
     if q1<>q2 then
       do_error(2211);
     s:='18446744073709551616';
     val(s,q2,code);
     if code=0 then
       do_error(2212);
  end;

procedure testmodqword;

  var
     q0,q1,q2,q3,q4,q5,q6 : qword;
     i : longint;

  begin
     assignqword(0,0,q0);
     assignqword(0,3,q1);
     assignqword(0,5,q2);
     assignqword(0,2,q3);
     assignqword(0,4,q4);
     assignqword(0,1,q5);
     assignqword($ffff,$12344321,q6);
     { to some trivial tests       }
     { to test the code generation }
     if q2 mod q1<>q3 then
       do_error(2300);
     if q2 mod q1 mod q3<>q0 then
       do_error(2301);
     if q2 mod (q1 mod q3)<>q0 then
       do_error(2302);
     if (q1 mod q3) mod q2<>q5 then
       do_error(2303);
     if q1 mod q2<>q1 then
       do_error(2308);

     { a more complex expression }
     if (q2 mod q4) mod (q1 mod q3)<>(q1 mod q3) mod (q2 mod q4) then
       do_error(2304);

     { now test the modulo division procedure with random bit patterns }
     writeln('Doing some random module divisions, takes a few seconds');
     writeln('.................100%');
     for i:=1 to 100000 do
       begin
          tqwordrec(q1).high:=random($7ffffffe);
          tqwordrec(q1).low:=random($7ffffffe);
          tqwordrec(q2).high:=random($7ffffffe);
          tqwordrec(q2).low:=random($7ffffffe);
          { avoid division by zero }
          if (tqwordrec(q2).low or tqwordrec(q2).high)=0 then
            tqwordrec(q2).low:=1;
          q3:=q1 mod q2;
          if (q1-q3) mod q2<>q0 then
            begin
               write('Modulo division of ');
               dumpqword(q1);
               write(' by ');
               dumpqword(q2);
               writeln(' failed');
               do_error(2306);
            end;
          if i mod 10000=0 then
            write('.');
       end;
     for i:=1 to 100000 do
       begin
          tqwordrec(q1).high:=random($7ffffffe);
          tqwordrec(q1).low:=random($7ffffffe);
          tqwordrec(q2).high:=0;
          tqwordrec(q2).low:=random($7ffffffe);
          { avoid division by zero }
          if tqwordrec(q2).low=0 then
            tqwordrec(q2).low:=1;
          { get a restless division }
          q3:=q1 mod q2;
          if (q1-q3) mod q2<>q0 then
            begin
               write('Modulo division of ');
               dumpqword(q1);
               write(' by ');
               dumpqword(q2);
               writeln(' failed');
               do_error(2307);
            end;
          if i mod 10000=0 then
            write('.');
       end;
     writeln(' OK');
  end;

const
   constqword : qword = 131975;

procedure testconstassignqword;

  var
     q1,q2,q3 : qword;

  begin
     // constant assignments
     assignqword(0,5,q2);
     q1:=5;
     if q1<>q2 then
       do_error(2400);

     // constants in expressions
     q1:=1234;
     if q1<>1234 then
       do_error(2401);

     // typed constants
     assignqword(0,131975,q1);
     q2:=131975;
     if q1<>q2 then
       do_error(2402);

     //!!!!! large constants are still missed
  end;

{$Q+}
procedure testreqword;

  var
     q0,q1,q2,q3 : qword;

  begin
     q0:=0;
     assignqword($ffffffff,$ffffffff,q1);
     q2:=1;

     // addition
     try
       // expect an exception
       q3:=q1+q2;
       do_error(2500);
     except
       on eintoverflow do
         ;
       else
       do_error(2501);
     end;
     // subtraction
     try
       q3:=q0-q2;
       do_error(2502);
     except
       on eintoverflow do
         ;
       else
       do_error(2503);
     end;

     // multiplication
     q2:=2;
     try
       q3:=q2*q1;
       do_error(2504);
     except
       on eintoverflow do
         ;
       else
       do_error(2505);
     end;

     // division
     try
       q3:=q1 div q0;
       do_error(2506);
     except
       on edivbyzero do
         ;
       else
       do_error(2507);
     end;

     // modulo division
     try
       q3:=q1 mod q0;
       do_error(2508);
     except
       on edivbyzero do
         ;
       else
       do_error(2509);
     end;
{$Q-}

     // now we do the same operations but without overflow
     // checking -> we should get no exceptions
     q2:=1;

     // addition
     try
       q3:=q1+q2;
     except
       do_error(2510);
     end;
     // subtraction
     try
       q3:=q0-q2;
     except
       do_error(2511);
     end;

     // multiplication
     q2:=2;
     try
       q3:=q2*q1;
     except
       do_error(2512);
     end;

  end;

procedure testintqword;

  var
     q1,q2,q3 : qword;

  begin
     // lo/hi
     assignqword($fafafafa,$03030303,q1);
     if lo(q1)<>$03030303 then
       do_error(2600);
     if hi(q1)<>$fafafafa then
       do_error(2601);
     if lo(q1+1)<>$03030304 then
       do_error(2602);
     if hi(q1+$f0000000)<>$fafafafa then
       do_error(2603);

     // swap
     assignqword($03030303,$fafafafa,q2);
     if swap(q1)<>q2 then
       do_error(2604);

    // succ/pred
    assignqword(0,$1,q1);
    q3:=q1;
    q1:=succ(q1);
    q1:=succ(q1+1);
    q2:=pred(q1-1);
    q2:=pred(q2);
    if q3<>q2 then
      do_error(2605);
    assignqword(0,$ffffffff,q1);
    q3:=q1;
    q1:=succ(q1);
    q1:=succ(q1+1);
    q2:=pred(q1-1);
    q2:=pred(q2);
    if q3<>q2 then
      do_error(2606);
  end;

procedure testcritical;

  var
     a : array[0..10,0..10,0..10] of qword;
     i,j,k : longint;
     d1,d2 : extended;
     q1,q2 : qword;
     i1,i2 : int64;

  begin
     i:=1;
     j:=3;
     k:=5;
     { check if it is handled correct if a register is used }
     { in a reference as well as temp. reg                  }
     a[i,j,k]:=1234;
     a[i,j,k]:=a[i,j,k]+a[i,j,k];
     if a[i,j,k]<>2468 then
       do_error(2700);
     if not(not(a[i,j,k]))<>a[i,j,k] then
       do_error(2701);
     if -(-(a[i,j,k]))<>a[i,j,k] then
       do_error(2702);
     if (a[i,j,k] shl (i-i))<>a[i,j,k] then
       do_error(2703);
     q1:=10;
     q2:=100;
     i1:=1000;
     i2:=10000;
     d1:=q1/q2;
     d2:=i1/i2;
     if (d1<>d2) then
       do_error(2704);
  end;

var
   q : qword;

begin
   randomize;
   writeln('------------------------------------------------------');
   writeln('                    QWord test ');
   writeln('------------------------------------------------------');
   writeln;

   writeln('Testing assignqword and dumpqword ... ');
   assignqword($12345678,$9ABCDEF0,q);
   dumpqword(q);
   writeln;
   writeln('The output should be:');
   writeln('$12345678 9ABCDEF0');
   writeln;

   writeln('Testing simple QWord comparisations');
   simpletestcmpqword;
   writeln('Testing simple QWord comparisations was successful');
   writeln;

   writeln('Testing QWord additions');
   testaddqword;
   writeln('Testing QWord additions was successful');
   writeln;

   writeln('Testing more QWord comparisations');
   testcmpqword;
   writeln('Testing more QWord comparisations was successful');
   writeln;

   writeln('Testing QWord subtraction');
   testsubqword;
   writeln('Testing QWord subtraction was successful');
   writeln;

   writeln('Testing QWord constants');
   testconstassignqword;
   writeln('Testing QWord constants was successful');
   writeln;

   writeln('Testing QWord logical operators (or,xor,and)');
   testlogqword;
   writeln('Testing QWord logical operators (or,xor,and) was successful');
   writeln;

   writeln('Testing QWord logical not operator');
   testnotqword;
   writeln('Testing QWord logical not operator was successful');
   writeln;

   writeln('Testing QWord logical - operator');
   testnegqword;
   writeln('Testing QWord logical - operator was successful');
   writeln;

   writeln('Testing QWord logical shift operators (shr,shr)');
   testshlshrqword;
   writeln('Testing QWord logical shift operators (shr,shr) was successful');
   writeln;

   writeln('Testing QWord function results');
   testfuncqword;
   writeln('Testing QWord function results was successful');
   writeln;

   writeln('Testing QWord type casts');
   testtypecastqword;
   writeln('Testing QWord type casts was successful');
   writeln;

   writeln('Testing QWord internal procedures');
   testintqword;
   writeln('Testing QWord internal procedures was successful');
   writeln;

   writeln('Testing QWord multiplications');
   testmulqword;
   writeln('Testing QWord multiplications was successful');
   writeln;

   writeln('Testing QWord division');
   testdivqword;
   writeln('Testing QWord division was successful');
   writeln;

   writeln('Testing QWord modulo division');
   testmodqword;
   writeln('Testing QWord modulo division was successful');
   writeln;

   writeln('Testing QWord runtime errors');
   testreqword;
   writeln('Testing QWord runtime errors was successful');
   writeln;

   writeln('Testing QWord string conversion');
   teststringqword;
   writeln('Testing QWord string conversion was successful');
   writeln;

   writeln('Testing QWord input/output');
   testioqword;
   writeln('Testing QWord input/output was successful');
   writeln;

   writeln('Some extra tests for critical things');
   testcritical;
   writeln('Extra tests for critical things were successful');

   writeln('------------------------------------------------------');
   writeln('              QWord test successful');
   writeln('------------------------------------------------------');
   writeln;
   writeln('------------------------------------------------------');
   writeln('                    Int64 test ');
   writeln('------------------------------------------------------');
   writeln;

   writeln('------------------------------------------------------');
   writeln('                Int64 test successful');
   writeln('------------------------------------------------------');
   halt(0);
end.

Link to SVN view of test/tint642.pp source.