Переглянути джерело

* fixed issue #6977 (add regvars occupied by the invisible high parameter
of "open array" and "array of const" parameters to the used regvars
for their array accesses if range checking is turned on)

git-svn-id: trunk@3914 -

Jonas Maebe 19 роки тому
батько
коміт
df973fa1de
5 змінених файлів з 75 додано та 4 видалено
  1. 1 0
      .gitattributes
  2. 1 0
      compiler/ncgmem.pas
  3. 9 1
      compiler/ncgutil.pas
  4. 10 3
      compiler/nutils.pas
  5. 54 0
      tests/webtbs/tw6977.pp

+ 1 - 0
.gitattributes

@@ -7191,6 +7191,7 @@ tests/webtbs/tw6735.pp svneol=native#text/plain
 tests/webtbs/tw6742.pp svneol=native#text/plain
 tests/webtbs/tw6767.pp svneol=native#text/plain
 tests/webtbs/tw6960.pp svneol=native#text/plain
+tests/webtbs/tw6977.pp svneol=native#text/plain
 tests/webtbs/tw6980.pp svneol=native#text/plain
 tests/webtbs/tw6989.pp svneol=native#text/plain
 tests/webtbs/tw7006.pp svneol=native#text/plain

+ 1 - 0
compiler/ncgmem.pas

@@ -646,6 +646,7 @@ implementation
                          st_shortstring:
                            begin
                               {!!!!!!!!!!!!!!!!!}
+                              { if this one is implemented making use of the high parameter for openshortstrings, update ncgutils.do_get_used_regvars() too (JM) }
                            end;
 
                          st_longstring:

+ 9 - 1
compiler/ncgutil.pas

@@ -162,7 +162,7 @@ implementation
     procinfo,paramgr,fmodule,
     regvars,dbgbase,
     pass_1,pass_2,
-    nbas,ncon,nld,nutils,
+    nbas,ncon,nld,nmem,nutils,
     tgobj,cgobj
 {$ifdef powerpc}
     , cpupi
@@ -2207,6 +2207,14 @@ implementation
           loadn:
             if (tloadnode(n).symtableentry.typ in [globalvarsym,localvarsym,paravarsym]) then
               add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc);
+          vecn:
+            { range checks sometimes need the high parameter }
+            if (cs_check_range in aktlocalswitches) and
+               (is_open_array(tvecnode(n).left.resulttype.def) or
+                is_array_of_const(tvecnode(n).left.resulttype.def)) and
+               not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+              add_regvars(rv^,tabstractnormalvarsym(get_high_value_sym(tparavarsym(tloadnode(tvecnode(n).left).symtableentry))).localloc)
+
         end;
         result := fen_true;
       end;

+ 10 - 3
compiler/nutils.pas

@@ -27,7 +27,7 @@ interface
 
   uses
     globals,
-    symsym,node;
+    symtype,symsym,node;
 
   const
     NODE_COMPLEXITY_INF = 255;
@@ -57,6 +57,7 @@ interface
 
     procedure load_procvar_from_calln(var p1:tnode);
     function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
+    function get_high_value_sym(vs: tparavarsym):tsym; { marking it as inline causes IE 200311075 during loading from ppu file }
     function load_high_value_node(vs:tparavarsym):tnode;
     function load_self_node:tnode;
     function load_result_node:tnode;
@@ -79,7 +80,7 @@ implementation
 
     uses
       globtype,verbose,
-      symconst,symbase,symtype,symdef,symtable,
+      symconst,symbase,symdef,symtable,
       defutil,defcmp,
       nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd,nmem,
       cgbase,procinfo,
@@ -275,12 +276,18 @@ implementation
       end;
 
 
+    function get_high_value_sym(vs: tparavarsym):tsym;
+      begin
+        result := tsym(vs.owner.search('high'+vs.name));
+      end;
+
+
     function load_high_value_node(vs:tparavarsym):tnode;
       var
         srsym : tsym;
       begin
         result:=nil;
-        srsym:=tsym(vs.owner.search('high'+vs.name));
+        srsym:=get_high_value_sym(vs);
         if assigned(srsym) then
           begin
             result:=cloadnode.create(srsym,vs.owner);

+ 54 - 0
tests/webtbs/tw6977.pp

@@ -0,0 +1,54 @@
+program bug1;
+
+{$mode objfpc}{$H+}
+{$r+}
+
+uses Classes;
+
+type
+
+  TCTEntry = record
+    Name: AnsiString;
+    g: Integer;
+  end;
+
+  TCT = record
+    Size: Integer;
+    Names: array of PChar;
+    IReps: array of TCTEntry;
+  end;
+
+
+const
+
+  C: array [0..2] of TCTEntry =
+  ((Name:'A'; g:0),
+   (Name:'B'; g:0),
+   (Name:'C'; g:1));
+
+
+var
+  CTs: array [0..1] of TCT;
+  p: Integer;
+
+  procedure A(T: array of TCTEntry);
+  var
+    i: Integer;
+  begin
+    with CTs[p] do begin
+      Size := Length(T);
+      Setlength(IReps, Size);
+      Setlength(Names, Size+1);
+      Names[Size] := nil;
+      for i := 0 to Size-1 do begin
+        Names[i] := PChar(T[i].Name);
+        IReps[i] := T[i];
+      end;
+    end;
+  end;
+
+begin
+  p := 0;
+  A(C);
+end.
+