* i8086 far code memory model fixes in tests tw2739,tw3173,tw16034,tw1152,

tw2944 and tw9261

git-svn-id: trunk@25832 -

tests/webtbs/tw1152.pp

@@ -10,7 +10,7 @@
 program exception;
 uses sysutils,crt;
 var
-  saveexit : pointer;
+  saveexit : codepointer;
   finally_called : boolean;
 
 procedure my_exit;

tests/webtbs/tw16034.pp

@@ -9,6 +9,11 @@ program Hello;
 
 type
   ptr = pointer;
+{$ifdef fpc}
+  codeptr = codepointer;
+{$else}
+  codeptr = pointer;
+{$endif}
   Int = ptrint;
   pPtr = ^ptr;
   UInt = ptruint;
@@ -109,7 +114,7 @@ var
 
   s0, s1, s2: UInt;
   v0, v1, v2: ptr;
-  cn0, cn1, cn2: ptr;
+  cn0, cn1, cn2: codeptr;
 
 begin
   // VMT Pointers

tests/webtbs/tw2739.pp

@@ -26,7 +26,7 @@ end;
 
 function JclAddExceptNotifier(const NotifyMethod: TJclExceptNotifyMethod): Boolean; overload;
 var
-  p : pointer;
+  p : codepointer;
 begin
   p:=@NotifyMethod;
 end;

tests/webtbs/tw2944.pp

@@ -4,9 +4,13 @@
 
 {$ifdef fpc}{$mode Delphi}{$endif}
 type
+{$ifndef fpc}
+  CodePointer = Pointer;
+  PCodePointer = PPointer;
+{$endif}
   WS2StubEntry = record
-    StubProc : Pointer;
-    ProcVar : PPointer;
+    StubProc : CodePointer;
+    ProcVar : PCodePointer;
     Name : PChar;
   end;
   LPFN_WSACLEANUP = function : Integer; stdcall;

tests/webtbs/tw3173.pp

@@ -2,11 +2,16 @@
 { Submitted by "Dominik Zablotny" on  2004-06-18 }
 { e-mail: dominz@wp.pl }
 program test;
-{$ifdef fpc}{$mode delphi}{$endif}
+{$ifdef fpc}
+  {$mode delphi}
+{$else}
+type
+  codepointer = pointer;
+{$endif}
 var
   p: procedure of object;
 
-  function f:pointer;
+  function f:codepointer;
   begin
   end;
 

tests/webtbs/tw9261.pp

@@ -7,7 +7,7 @@ type methodprocvar = function(): Boolean of object;
 procedure test_procedure(a1, a2, a3, a4, a5, a6: integer; mv: methodprocvar);
 begin
   with Tmethod(mv) do
-    if (code<>pointer($11111111)) or (data<>pointer($22222222)) then
+    if (code<>codepointer($11111111)) or (data<>pointer($22222222)) then
        begin
          writeln('test failed');
          halt(1);
@@ -19,7 +19,7 @@ var a:methodprocvar;
 begin
   with Tmethod(a) do
     begin
-      code:=pointer($11111111);
+      code:=codepointer($11111111);
       data:=pointer($22222222);
     end;
   test_procedure(1, 2, 3, 4, 5, 6, a);