Ver Fonte

--- Merging r15918 into '.':
A tests/webtbs/tw17283.pp
U compiler/htypechk.pas
--- Merging r15921 into '.':
U tests/webtbs/tw17283.pp
U compiler/nmem.pas

git-svn-id: branches/fixes_2_4@15936 -

Jonas Maebe há 15 anos atrás
pai
commit
8aa9b77592
4 ficheiros alterados com 110 adições e 6 exclusões
  1. 1 0
      .gitattributes
  2. 13 6
      compiler/htypechk.pas
  3. 10 0
      compiler/nmem.pas
  4. 86 0
      tests/webtbs/tw17283.pp

+ 1 - 0
.gitattributes

@@ -9527,6 +9527,7 @@ tests/webtbs/tw1696.pp svneol=native#text/plain
 tests/webtbs/tw1699.pp svneol=native#text/plain
 tests/webtbs/tw1709.pp svneol=native#text/plain
 tests/webtbs/tw1720.pp svneol=native#text/plain
+tests/webtbs/tw17283.pp svneol=native#text/plain
 tests/webtbs/tw1735.pp svneol=native#text/plain
 tests/webtbs/tw1737.pp svneol=native#text/plain
 tests/webtbs/tw1744.pp svneol=native#text/plain

+ 13 - 6
compiler/htypechk.pas

@@ -717,15 +717,22 @@ implementation
               end;
             vecn:
               begin
-                { arrays are currently never regable and pointers indexed like }
-                { arrays do not have be made unregable, but we do need to      }
-                { propagate the ra_addr_taken info                             }
-                update_regable:=false;
-                p:=tvecnode(p).left;
+                { if there's an implicit dereference, we can stop (just like
+                  when there is an actual derefn) }
+                if ((tvecnode(p).left.resultdef.typ=arraydef) and
+                    not is_special_array(tvecnode(p).left.resultdef)) or
+                   ((tvecnode(p).left.resultdef.typ=stringdef) and
+                    (tstringdef(tvecnode(p).left.resultdef).stringtype in [st_shortstring,st_longstring])) then
+                  p:=tvecnode(p).left
+                else
+                  break;
               end;
             typeconvn :
                begin
-                 if (ttypeconvnode(p).resultdef.typ = recorddef) then
+                 { implicit dereference -> stop }
+                 if (ttypeconvnode(p).convtype=tc_pointer_2_array) then
+                   break;
+                 if (ttypeconvnode(p).resultdef.typ=recorddef) then
                    records_only:=false;
                  p:=ttypeconvnode(p).left;
                end;

+ 10 - 0
compiler/nmem.pas

@@ -749,6 +749,16 @@ implementation
                inserttypeconv(right,sinttype);
            end;
 
+         { although we never put regular arrays or shortstrings in registers,
+           it's possible that another type was typecasted to a small record
+           that has a field of one of these types -> in that case the record
+           can't be a regvar either }
+         if ((left.resultdef.typ=arraydef) and
+             not is_special_array(left.resultdef)) or
+            ((left.resultdef.typ=stringdef) and
+             (tstringdef(left.resultdef).stringtype in [st_shortstring,st_longstring])) then
+           make_not_regable(left,[ra_addr_regable]);
+
          case left.resultdef.typ of
            arraydef :
              begin

+ 86 - 0
tests/webtbs/tw17283.pp

@@ -0,0 +1,86 @@
+{$mode objfpc}
+
+  program test;
+
+  type
+    tr_32=packed record
+      case integer of
+      1: (words: array [0..1] of word);
+      2: (low,high: word);
+      end;
+(*
+  procedure f_ref(var l,h:word);
+  begin
+    l:=1;
+    h:=2;
+    end;
+
+  function f_test1:longint;
+  begin
+    result:=$12345678;
+    f_ref(tr_32(result).words[0],tr_32(result).words[1]);
+    end;
+
+  function f_test2:longint;
+  begin
+    result:=$12345678;
+    f_ref(tr_32(result).low,tr_32(result).high);
+    end;
+
+  function f_test3:longint;
+  var
+    q: longint;
+  begin
+    q:=$12345678;
+    f_ref(tr_32(q).words[0],tr_32(q).words[1]);
+    result:=q;
+    end;
+*)
+  function f_test4:longint;
+  var
+    q: longint;
+  begin
+    q:=$12345678;
+    tr_32(q).words[0]:=1;
+    tr_32(q).words[1]:=2;
+    result:=q;
+    end;
+    
+  var
+    l,q: longint;
+    
+  begin
+(*
+    l:=f_test1;
+    if (tr_32(l).low<>1) or
+       (tr_32(l).high<>2) then
+      halt(1);
+
+    l:=f_test2;
+    if (tr_32(l).low<>1) or
+       (tr_32(l).high<>2) then
+      halt(2);
+
+    q:=$12345678;
+    f_ref(tr_32(q).words[0],tr_32(q).words[1]);
+    if (tr_32(q).low<>1) or
+       (tr_32(q).high<>2) then
+      halt(3);
+    
+    q:=$12345678;
+    f_ref(tr_32(q).low,tr_32(q).high);
+    if (tr_32(q).low<>1) or
+       (tr_32(q).high<>2) then
+      halt(4);
+    
+    l:=f_test3;
+    if (tr_32(l).low<>1) or
+       (tr_32(l).high<>2) then
+      halt(5);
+*)
+    l:=f_test4;
+    if (tr_32(l).low<>1) or
+       (tr_32(l).high<>2) then
+      halt(6);
+end.
+