* fix for #25956: left is not necessarily the array load node when accessing an open array/array of const element

git-svn-id: trunk@27487 -

.gitattributes

@@ -13902,6 +13902,7 @@ tests/webtbs/tw25895.pp svneol=native#text/pascal
 tests/webtbs/tw25929.pp svneol=native#text/pascal
 tests/webtbs/tw2594.pp svneol=native#text/plain
 tests/webtbs/tw2595.pp svneol=native#text/plain
+tests/webtbs/tw25956.pp svneol=native#text/pascal
 tests/webtbs/tw25959.pp svneol=native#text/pascal
 tests/webtbs/tw2602.pp svneol=native#text/plain
 tests/webtbs/tw2607.pp svneol=native#text/plain

compiler/ncgmem.pas

@@ -728,10 +728,10 @@ implementation
           begin
             { cdecl functions don't have high() so we can not check the range }
             { (can't use current_procdef, since it may be a nested procedure) }
-            if not(tprocdef(tparasymtable(tparavarsym(tloadnode(left).symtableentry).owner).defowner).proccalloption in cdecl_pocalls) then
+            if not(tprocdef(tparasymtable(tparavarsym(tloadnode(get_open_const_array(left)).symtableentry).owner).defowner).proccalloption in cdecl_pocalls) then
              begin
                { Get high value }
-               hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));
+               hightree:=load_high_value_node(tparavarsym(tloadnode(get_open_const_array(left)).symtableentry));
                { it must be available }
                if not assigned(hightree) then
                  internalerror(200212201);

compiler/nmem.pas

@@ -987,14 +987,19 @@ implementation
                { webtbs/tw8975                                                }
                if (cs_check_range in current_settings.localswitches) and
                   (is_open_array(left.resultdef) or
-                   is_array_of_const(left.resultdef)) and
-                  { cdecl functions don't have high() so we can not check the range }
-                  { (can't use current_procdef, since it may be a nested procedure) }
-                  not(tprocdef(tparasymtable(tparavarsym(tloadnode(left).symtableentry).owner).defowner).proccalloption in cdecl_pocalls) then
+                   is_array_of_const(left.resultdef)) then
                    begin
-                     { load_high_value_node already typechecks }
-                     hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));
-                     hightree.free;
+                     { expect to find the load node }
+                     if get_open_const_array(left).nodetype<>loadn then
+                       internalerror(2014040601);
+                     { cdecl functions don't have high() so we can not check the range }
+                     { (can't use current_procdef, since it may be a nested procedure) }
+                     if not(tprocdef(tparasymtable(tparavarsym(tloadnode(get_open_const_array(left)).symtableentry).owner).defowner).proccalloption in cdecl_pocalls) then
+                       begin
+                         { load_high_value_node already typechecks }
+                         hightree:=load_high_value_node(tparavarsym(tloadnode(get_open_const_array(left)).symtableentry));
+                         hightree.free;
+                       end;
                    end;
              end;
            pointerdef :

compiler/nutils.pas

@@ -135,6 +135,12 @@ interface
       node tree }
     procedure replacenode(var dest,src : tnode);
 
+    { strip off deref/addr combinations when looking for a the load node of an open array/array of const
+      since there is no possiblity to defined a pointer to an open array/array of const, we have not to
+      take care of type casts, further, it means also that deref/addr nodes must always appear coupled
+    }
+    function get_open_const_array(p : tnode) : tnode;
+
 implementation
 
     uses
@@ -1192,5 +1198,11 @@ implementation
       end;
 
 
+    function get_open_const_array(p : tnode) : tnode;
+      begin
+        result:=p;
+        if (p.nodetype=derefn) and (tderefnode(p).left.nodetype=addrn) then
+          result:=get_open_const_array(taddrnode(tderefnode(result).left).left);
+      end;
 
 end.

tests/webtbs/tw25956.pp

@@ -0,0 +1,23 @@
+{$r+}
+program project1;
+{$t+}
+var
+  a : array of integer;
+  i : integer;
+
+procedure Foo(var c: array of integer);
+begin
+  writeln( (@c)^[1] );
+  i:=(@c)^[1];
+end;
+
+begin
+  i:=$1234;
+  SetLength(a,5);
+  a[0]:= 100;
+  a[1]:= 101;
+  foo(a);
+  if i<>101 then
+    halt(1);
+  writeln('ok');
+end.