* fixed the return type of FarAddr(), so that it is assignment compatible to

  typed far pointers as well

git-svn-id: trunk@37629 -

compiler/i8086/n8086inl.pas

@@ -95,7 +95,10 @@ implementation
              inserttypeconv_internal(addr_node,u32inttype);
              left:=nil;
              result:=caddnode.create(addn,seg_node,addr_node);
-             inserttypeconv_internal(result,tcpupointerdef.getreusablex86(addr_node_resultdef,x86pt_far));
+             if addr_node_resultdef.typ=pointerdef then
+               inserttypeconv_internal(result,tcpupointerdef.getreusablex86(tpointerdef(addr_node_resultdef).pointeddef,x86pt_far))
+             else
+               inserttypeconv_internal(result,voidfarpointertype);
            end;
        end;
 

tests/test/cpu16/i8086/tfaradr1.pp

@@ -2,6 +2,9 @@
 
 program tfaradr1;
 
+type
+  PFarInteger = ^Integer; far;
+
 var
   global_variable: Integer;
 
@@ -13,8 +16,16 @@ end;
 
 procedure test_local_variable;
 var
+  pfv: FarPointer;
+  pfi: PFarInteger;
   local_variable: Integer;
 begin
+  pfv := FarAddr(local_variable);
+  if pfv <> Ptr(Seg(local_variable), Ofs(local_variable)) then
+    Fail('local_variable');
+  pfi := FarAddr(local_variable);
+  if pfi <> Ptr(Seg(local_variable), Ofs(local_variable)) then
+    Fail('local_variable');
   if FarAddr(local_variable) <> Ptr(Seg(local_variable), Ofs(local_variable)) then
     Fail('local_variable');
 end;
@@ -25,13 +36,24 @@ begin
 end;
 
 var
+  pfv: FarPointer;
+  pfi: PFarInteger;
   proc_addr: FarPointer;
 begin
+  { test FarAddr(global_variable) }
+  pfv := FarAddr(global_variable);
+  if pfv <> Ptr(Seg(global_variable), Ofs(global_variable)) then
+    Fail('global_variable');
+  pfi := FarAddr(global_variable);
+  if pfi <> Ptr(Seg(global_variable), Ofs(global_variable)) then
+    Fail('global_variable');
   if FarAddr(global_variable) <> Ptr(Seg(global_variable), Ofs(global_variable)) then
     Fail('global_variable');
 
+  { test FarAddr(local_variable) }
   test_local_variable;
 
+  { test FarAddr(proc) }
   proc_addr := FarAddr(proc);
   if proc_addr <> Ptr(Seg(proc), Ofs(proc)) then
     Fail('proc');