Parcourir la source

* enhanced int64/qword test files

florian il y a 26 ans
Parent
commit
98ce3acbfd
2 fichiers modifiés avec 66 ajouts et 19 suppressions
  1. 42 0
      tests/testi642.pp
  2. 24 19
      tests/testin64.pp

+ 42 - 0
tests/testi642.pp

@@ -0,0 +1,42 @@
+{$i rtl\inc\int64.inc}
+
+procedure dumpqword(q : qword);
+
+  begin
+     write('$',hexstr(tqwordrec(q).high,8),' ',hexstr(tqwordrec(q).low,8));
+  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 line',l);
+     halt(1);
+  end;
+
+{ $define error:=do_error({$line});}
+
+procedure testcmpqword;
+
+  var
+     q1,q2,q3 : qword;
+
+  begin
+     assignqword(0,5,q1);
+     assignqword(6,0,q2);
+     assignqword(6,5,q1);
+  end;
+
+var
+   q : qword;
+
+begin
+   assignqword($12345678,$9ABCDEF0,q);
+   dumpqword(q);
+end.

+ 24 - 19
tests/testin64.pp

@@ -24,6 +24,28 @@ function f2 : int64;
   end;
 
 begin
+   q:=q-q;
+   q:=q-(q*q);
+   q:=(q*q)-(q*q);
+   { first test the comparisation }
+   if q<>q then
+     begin
+        writeln('Error :(');
+     end;
+
+   if q>q then
+     begin
+        writeln('Error :(');
+     end;
+
+   if i>f2 then
+     begin
+        writeln('Error :(');
+     end;
+   if l1>l2 then
+     begin
+        writeln('Error :(');
+     end;
    p1(q,i);
    q:=f1;
    i:=f2;
@@ -45,7 +67,9 @@ begin
    i:=-(i or i);
 
    { multiplication }
+   // q:=3;
    q:=q*q;
+
    i:=i*i;
 
    q:=q*(q*q);
@@ -54,25 +78,6 @@ begin
    q:=(q*q)*(q*q);
    q:=((q*q)*(q*q))*((q*q)*(q*q));
 
-   if q<>q then
-     begin
-        writeln('Error :(');
-     end;
-
-   if q>q then
-     begin
-        writeln('Error :(');
-     end;
-
-   if i>f2 then
-     begin
-        writeln('Error :(');
-     end;
-   if l1>l2 then
-     begin
-        writeln('Error :(');
-     end;
-
    write(q);
    write(i);
    read(q);