* mark values typecasted to regular array types and indexed as non-regable,

    so that they aren't forced into a temporary location when passed to a
    var parameter later on (mantis #17283)

git-svn-id: trunk@15918 -

.gitattributes

@@ -10638,6 +10638,7 @@ tests/webtbs/tw17213.pp svneol=native#text/pascal
 tests/webtbs/tw17220.pp svneol=native#text/plain
 tests/webtbs/tw17220a.pp svneol=native#text/plain
 tests/webtbs/tw17236.pp svneol=native#text/pascal
+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

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;

tests/webtbs/tw17283.pp

@@ -0,0 +1,85 @@
+{$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_test3;
+    if (tr_32(l).low<>1) or
+       (tr_32(l).high<>2) then
+      halt(6);
+end.
+