Browse Source

* i8086 medium/compact memory model fixes in tests tb0368,tb0423,tb0433,tb0433a,
tb0508 and tb0594

git-svn-id: trunk@25822 -

nickysn 11 years ago
parent
commit
38ad4974fd
6 changed files with 21 additions and 7 deletions
  1. 2 1
      tests/tbs/tb0368.pp
  2. 5 1
      tests/tbs/tb0423.pp
  3. 4 1
      tests/tbs/tb0433.pp
  4. 5 2
      tests/tbs/tb0433a.pp
  5. 1 1
      tests/tbs/tb0508.pp
  6. 4 1
      tests/tbs/tb0594.pp

+ 2 - 1
tests/tbs/tb0368.pp

@@ -1,7 +1,8 @@
 type
   tproc = procedure of object;
   trec = record
-    l1,l2 : ptrint;
+    l1 : codeptrint;
+    l2 : ptrint;
   end;
 var
   pfn : tproc;

+ 5 - 1
tests/tbs/tb0423.pp

@@ -1,8 +1,12 @@
 {$ifdef fpc}{$mode delphi}{$endif}
 
 type
+{$ifndef fpc}
+  codepointer = pointer;
+{$endif}
    tmethod = record
-      code,data : pointer;
+      code : codepointer;
+      data : pointer;
    end;
 
 var

+ 4 - 1
tests/tbs/tb0433.pp

@@ -1,5 +1,8 @@
 {$ifdef fpc}
 {$mode tp}
+{$else fpc}
+type
+  codepointer = pointer;
 {$endif fpc}
 
 function times2(x : longint) : longint;
@@ -10,7 +13,7 @@ end;
 
 var
  x:function(x:longint):longint;
- y:pointer absolute x;
+ y:codepointer absolute x;
  z,w,v:pointer;
 begin
  z:=@@x;

+ 5 - 2
tests/tbs/tb0433a.pp

@@ -1,5 +1,8 @@
 {$ifdef fpc}
 {$mode delphi}
+{$else fpc}
+type
+  codepointer = pointer;
 {$endif fpc}
 
 function times2(x : longint) : longint;
@@ -10,8 +13,8 @@ end;
 
 var
  x:function(x:longint):longint;
- y:pointer absolute x;
- z,w,v:pointer;
+ y:codepointer absolute x;
+ z,w,v:codepointer;
 begin
  x:=times2;
  z:=@x;

+ 1 - 1
tests/tbs/tb0508.pp

@@ -3,7 +3,7 @@
 type
   PointerLocal = procedure(_EBP: Pointer);
 
-procedure proccall(p: pointer);
+procedure proccall(p: codepointer);
 begin
   PointerLocal(p)(get_caller_frame(get_frame));
 end;

+ 4 - 1
tests/tbs/tb0594.pp

@@ -3,6 +3,9 @@
 {$endif}
 
 type
+{$ifndef fpc}
+  codepointer = pointer;
+{$endif}
   tc = class
     class procedure test;
   end;
@@ -20,6 +23,6 @@ var
 begin
   p:=tp(tc.test);
   p2:=tc.test;
-  if pointer(@p)<>tmethod(p2).code then
+  if codepointer(@p)<>tmethod(p2).code then
     halt(1);
 end.