* mark invisible high parameters of open arrays/arrays of const

    of parent procedures which are implicitly accessed from within
    nested procedures for range checking purposes as non-regable in
    the resulttype pass of the nested procedure (as opposed to in its
    pass1/pass2, because by then the regvar assignment of the parent
    procedure is already finished) (mantis #8975)
  * related fix regarding checking whether the high parameter actually
    exists (must check calling convention of the procedure to which the
    high parameter belongs, which is not the same as checking that of
    the current procedure in case of nested procedures)

git-svn-id: trunk@7512 -

.gitattributes

@@ -8270,6 +8270,8 @@ tests/webtbs/tw8861.pp svneol=native#text/plain
 tests/webtbs/tw8870.pp svneol=native#text/plain
 tests/webtbs/tw8883.pp svneol=native#text/plain
 tests/webtbs/tw8919.pp svneol=native#text/plain
+tests/webtbs/tw8975.pp svneol=native#text/plain
+tests/webtbs/tw8975a.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

compiler/ncgmem.pas

@@ -543,7 +543,8 @@ implementation
             is_array_of_const(left.resultdef) then
           begin
             { cdecl functions don't have high() so we can not check the range }
-            if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+            { (can't use current_procdef, since it may be a nested procedure) }
+            if not(tprocdef(tparasymtable(tparavarsym(tloadnode(left).symtableentry).owner).defowner).proccalloption in [pocall_cdecl,pocall_cppdecl]) then
              begin
                { Get high value }
                hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));

compiler/nmem.pas

@@ -677,6 +677,7 @@ implementation
 
     function tvecnode.pass_typecheck:tnode;
       var
+         hightree: tnode;
          htype,elementdef : tdef;
          valid : boolean;
       begin
@@ -739,6 +740,31 @@ implementation
                  resultdef:=left.resultdef
                else
                  resultdef:=Tarraydef(left.resultdef).elementdef;
+
+               { if we are range checking an open array or array of const, we }
+               { need to load the high parameter. If the current procedure is }
+               { nested inside the procedure to which the open array/of const }
+               { was passed, then the high parameter must not be a regvar.    }
+               { So create a loadnode for the high parameter here and         }
+               { typecheck it, then the loadnode will make the high parameter }
+               { not regable. Otherwise this would only happen inside pass_2, }
+               { which is too late since by then the regvars are already      }
+               { assigned (pass_1 is also already too late, because then the  }
+               { regvars of the parent are also already assigned).            }
+               { 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 [pocall_cdecl,pocall_cppdecl]) then
+                   begin
+                     { load_high_value_node already typechecks }
+                     hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));
+                     hightree.free;
+                   end;
+      
+      
              end;
            pointerdef :
              begin
@@ -874,6 +900,7 @@ implementation
                 registersint:=max(registersint,1);
               }
            end;
+
          registersfpu:=max(left.registersfpu,right.registersfpu);
 {$ifdef SUPPORT_MMX}
          registersmmx:=max(left.registersmmx,right.registersmmx);

tests/webtbs/tw8975.pp

@@ -0,0 +1,20 @@
+{ %opt=-CRriot -O-2 -Ooregvar }
+
+{Internal FPC2.1.4 error, compile with fpc -B -dDebug -O3}
+procedure bug(const b: array of longint);
+  procedure intern;
+  begin
+    if (b[low(b)] <> 1) then {Fatal: Internal error 200409241}
+      halt(1);
+  end;
+begin
+  intern;
+end;
+
+const
+  a: array[1..3] of longint = (1,2,3);
+begin
+  bug(a);
+end.
+
+

tests/webtbs/tw8975a.pp

@@ -0,0 +1,20 @@
+{ %opt=-CRriot -O-2 -Ooregvar }
+
+{Internal FPC2.1.4 error, compile with fpc -B -dDebug -O3}
+procedure bug(const b: array of longint); cdecl;
+  procedure intern;
+  begin
+    if (b[low(b)] <> 1) then {Fatal: Internal error 200409241}
+      halt(1);
+  end;
+begin
+  intern;
+end;
+
+const
+  a: array[1..3] of longint = (1,2,3);
+begin
+  bug(a);
+end.
+
+