Przeglądaj źródła

compiler: calculate offset of record fields in taddrnode (based on patch of Jeppe Johansen, fixes bug #0019357)

git-svn-id: trunk@23428 -
paul 12 lat temu
rodzic
commit
65cbb4e9ba
3 zmienionych plików z 36 dodań i 2 usunięć
  1. 1 0
      .gitattributes
  2. 10 2
      compiler/nmem.pas
  3. 25 0
      tests/webtbs/tw19357.pp

+ 1 - 0
.gitattributes

@@ -12918,6 +12918,7 @@ tests/webtbs/tw1931.pp svneol=native#text/plain
 tests/webtbs/tw1932.pp svneol=native#text/plain
 tests/webtbs/tw19325.pp svneol=native#text/pascal
 tests/webtbs/tw1935.pp svneol=native#text/plain
+tests/webtbs/tw19357.pp svneol=native#text/pascal
 tests/webtbs/tw1936.pp svneol=native#text/plain
 tests/webtbs/tw19368.pp svneol=native#text/pascal
 tests/webtbs/tw1938.pp svneol=native#text/plain

+ 10 - 2
compiler/nmem.pas

@@ -466,6 +466,7 @@ implementation
          hp  : tnode;
          hsym : tfieldvarsym;
          isprocvar : boolean;
+         offset: asizeint;
       begin
         result:=nil;
         typecheckpass(left);
@@ -574,10 +575,17 @@ implementation
 {$endif i386}
                (tabsolutevarsym(tloadnode(hp).symtableentry).abstyp=toaddr) then
                begin
+                 offset:=tabsolutevarsym(tloadnode(hp).symtableentry).addroffset;
+                 hp:=left;
+                 while assigned(hp) and (hp.nodetype=subscriptn) do
+                   begin
+                     inc(offset,tsubscriptnode(hp).vs.fieldoffset);
+                     hp:=tunarynode(hp).left;
+                   end;
                  if nf_typedaddr in flags then
-                   result:=cpointerconstnode.create(tabsolutevarsym(tloadnode(hp).symtableentry).addroffset,getpointerdef(left.resultdef))
+                   result:=cpointerconstnode.create(offset,getpointerdef(left.resultdef))
                  else
-                   result:=cpointerconstnode.create(tabsolutevarsym(tloadnode(hp).symtableentry).addroffset,voidpointertype);
+                   result:=cpointerconstnode.create(offset,voidpointertype);
                  exit;
                end
               else if (nf_internal in flags) or

+ 25 - 0
tests/webtbs/tw19357.pp

@@ -0,0 +1,25 @@
+program tw19357;
+type
+  TLvl0 = packed record
+    a,b: longword;
+  end;
+
+  TTest = packed record
+    a,b: longword;
+    c: TLvl0;
+  end;
+
+var
+  h: TTest absolute 100;
+const
+  x: pointer = @h.c.b;
+begin
+  if ptruint(@h.a) <> 100 then
+    halt(1);
+  if ptruint(@h.b) <> 104 then
+    halt(2);
+  if ptruint(@h.c.b) <> 112 then
+    halt(3);
+  if ptruint(x) <> 112 then
+    halt(4);
+end.