* 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 -
This commit is contained in:
Jonas Maebe 2006-06-21 18:24:01 +00:00
parent 58703324a9
commit df973fa1de
5 changed files with 75 additions and 4 deletions

1
.gitattributes vendored
View File

@ -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

View File

@ -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:

View File

@ -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;

View File

@ -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
tests/webtbs/tw6977.pp Normal file
View File

@ -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.