Browse Source

* 64bit fixes

peter 21 years ago
parent
commit
4222f35ae3

+ 5 - 5
tests/test/cg/cdecl/taoc4.pp

@@ -14,18 +14,18 @@ const
 
 procedure test_one_longint(args : array of const);cdecl;
 var
-  p : plongint;
+  p : pptrint;
 begin
- p:=plongint(@args);
+ p:=pptrint(@args);
  l:=p^;
 end;
 
 procedure test_two_longints(args : array of const);cdecl;
 var
-  p : plongint;
+  p : pptrint;
 begin
- p:=plongint(@args);
- cardinal(p):=cardinal(p)+sizeof(longint);
+ p:=pptrint(@args);
+ inc(pointer(p),sizeof(ptrint));
  l:=p^;
 end;
 

+ 1 - 1
tests/test/cg/cdecl/taoc5.pp

@@ -27,7 +27,7 @@ var
   p : pdouble;
 begin
  p:=pdouble(@args);
- cardinal(p):=cardinal(p)+sizeof(double);
+ inc(pointer(p),sizeof(double));
  l:=p^;
 end;
 

+ 1 - 1
tests/test/cg/cdecl/taoc6.pp

@@ -30,7 +30,7 @@ var
   p : pint64;
 begin
  p:=pint64(@args);
- cardinal(p):=cardinal(p)+sizeof(int64);
+ inc(pointer(p),sizeof(int64));
  l:=p^;
 end;
 

+ 3 - 4
tests/test/tint642.pp

@@ -680,13 +680,12 @@ procedure testtypecastqword;
      // 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
+     if q1<>d2*d2*2.0 then
        do_error(20);
      // register location
-     d1:=q1+1;
-     if d1<>d2*d2*2.0+1 then
+     q1:=q1+1;
+     if q1<>d2*d2*2.0+1 then
        do_error(2014);
   end;
 

+ 21 - 12
tests/test/tstring4.pp

@@ -10,8 +10,17 @@ Program ansitest;
   {$define COMP_IS_INT64}
 {$endif FPC_COMP_IS_INT64}
 
+{$ifdef ver1_0}
+type
+  ptrint=longint;
+  sizeint=longint;
+{$endif}
+
 {$ifndef fpc}
-Function Memavail : Longint;
+type
+  ptrint=longint;
+  sizeint=longint;
+Function Memavail : ptrint;
 begin
  Result:=0;
 end;
@@ -21,7 +30,7 @@ end;
     General stuff
   ------------------------------------------------------------------- }
 
-Procedure DoMem (Var StartMem : Longint);
+Procedure DoMem (Var StartMem : sizeint);
 
 begin
   Writeln ('Lost ',StartMem-Memavail,' Bytes.');
@@ -30,16 +39,16 @@ end;
 
 Procedure DoRef (P : Pointer);
 
-Type PLongint = ^Longint;
+Type Psizeint = ^sizeint;
 
 begin
   If P=Nil then
     Writeln ('(Ref : Empty string)')
   else
 {$ifdef fpc}
-    Writeln (' (Ref: ',Plongint(Longint(P)-4)^,',Len: ',PLongint(Longint(P)-8)^,')');
+    Writeln (' (Ref: ',Psizeint(sizeint(P)-sizeof(sizeint))^,',Len: ',Psizeint(sizeint(P)-sizeof(sizeint)*2)^,')');
 {$else}
-    Writeln (' (Ref: ',Plongint(Longint(P)-8)^,',Len: ',PLongint(Longint(P)-4)^,')');
+    Writeln (' (Ref: ',Psizeint(sizeint(P)-8)^,',Len: ',Psizeint(sizeint(P)-4)^,')');
 {$endif}
 end;
 
@@ -60,7 +69,7 @@ Var
     S   : AnsiString;
     AR  : Arec;
     AAR : AnArray;
-    I   : longint;
+    I   : sizeint;
 
 Begin
   S:='This is an ansistring!';
@@ -130,7 +139,7 @@ end;
 Procedure TestParams;
 
 Var S : AnsiString;
-    Mem : Longint;
+    Mem : sizeint;
 
 begin
   Mem:=MemAvail;
@@ -290,7 +299,7 @@ end;
 Procedure testIndex;
 
 Var S,T : AnsiString;
-    I,Len : longint;
+    I,Len : sizeint;
 
 begin
   S:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
@@ -326,7 +335,7 @@ Const S1 : AnsiString = 'ABC';
 
 Var I : Integer;
     S3 : AnsiString;
-    mem : Longint;
+    mem : sizeint;
 
 begin
  mem:=memavail;
@@ -361,7 +370,7 @@ Var S,T : AnsiString;
     SS : ShortString;
     C : Char;
     Ca : Cardinal;
-    L : longint;
+    L : sizeint;
     I : Integer;
     W : Word;
     B : Byte;
@@ -370,7 +379,7 @@ Var S,T : AnsiString;
     E : Extended;
     Si : Single;
     Co : Comp;
-    TempMem:Longint;
+    TempMem:sizeint;
 begin
   TempMem:=Memavail;
   S:='ABCDEF';
@@ -456,7 +465,7 @@ begin
   Writeln (S);
 end;
 
-Var GlobalStartMem,StartMem : Longint;
+Var GlobalStartMem,StartMem : PtrInt;
 
 begin
   GlobalStartMem:=MemAvail;

+ 5 - 5
tests/test/units/strings/tstrcopy.pp

@@ -17,30 +17,30 @@ begin
           p := strcopy(@buf[j+32],@s[0]);
           if (p <> @buf[j+32]) then
             begin
-              writeln('error 0');
+              writeln('error 0 (i=',i,')');
               halt(1);
             end;
           for l := 0 to j+31 do
             if buf[l] <> 'a' then
               begin
-                writeln('error 1');
+                writeln('error 1 (i=',i,')');
                 halt(1);
               end;
           for l := j+32 to j+32+i-1 do
             if buf[l] <> 'b' then
               begin
-                writeln('error 2');
+                writeln('error 2 (i=',i,')');
                 halt(1);
               end;
           if buf[j+i+32] <> #0 then
             begin
-              writeln('error 3');
+              writeln('error 3 (i=',i,')');
               halt(1);
             end;
           for l := j+i+32+1 to 512 do
             if buf[l] <> 'a' then
               begin
-                writeln('error 4');
+                writeln('error 4 (i=',i,')');
                 halt(1);
               end;
         end;