mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 18:47:52 +02:00
* 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:
parent
58703324a9
commit
df973fa1de
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
@ -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:
|
||||
|
@ -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;
|
||||
|
@ -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
54
tests/webtbs/tw6977.pp
Normal 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.
|
||||
|
Loading…
Reference in New Issue
Block a user