paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-29 19:00:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* always force range checking for the upper and lower bounds of for-loops if

Browse Source 
they are constants (instead of only on 32 bit systems), and always use the
    actual upper/lower bound of the loop variable instead of hardcoding the
    bounds of longint (mantis #17646)

git-svn-id: trunk@16213 -
This commit is contained in:
Jonas Maebe 2010-10-24 14:55:48 +00:00
parent 1cea4ec221
commit 14b95b3b9b
9 changed files with 102 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -9958,6 +9958,7 @@ tests/webtbf/tw1681.pp svneol=native#text/plain
tests/webtbf/tw17455.pp svneol=native#text/plain
tests/webtbf/tw1754.pp svneol=native#text/plain
tests/webtbf/tw1754b.pp svneol=native#text/plain
tests/webtbf/tw17646a.pp svneol=native#text/plain
tests/webtbf/tw1782.pp svneol=native#text/plain
tests/webtbf/tw1827.pp svneol=native#text/plain
tests/webtbf/tw1830.pp svneol=native#text/plain
@ -10714,6 +10715,7 @@ tests/webtbs/tw1755.pp svneol=native#text/plain
tests/webtbs/tw17550.pp svneol=native#text/plain
tests/webtbs/tw1758.pp svneol=native#text/plain
tests/webtbs/tw17604.pp svneol=native#text/plain
tests/webtbs/tw17646.pp svneol=native#text/plain
tests/webtbs/tw1765.pp svneol=native#text/plain
tests/webtbs/tw17675.pp svneol=native#text/plain
tests/webtbs/tw17675a.pp svneol=native#text/plain

7
compiler/defutil.pas
View File

@ -223,7 +223,7 @@ interface
{# If @var(l) isn't in the range of todef a range check error (if not explicit) is generated and
the value is placed within the range
}
procedure testrange(todef : tdef;var l : tconstexprint;explicit:boolean);
procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
{# Returns the range of def, where @var(l) is the low-range and @var(h) is
the high-range.
@ -751,7 +751,7 @@ implementation
{ if l isn't in the range of todef a range check error (if not explicit) is generated and
the value is placed within the range }
procedure testrange(todef : tdef;var l : tconstexprint;explicit:boolean);
procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
var
lv,hv: TConstExprInt;
begin
@ -766,7 +766,8 @@ implementation
{ delphi allows range check errors in
enumeration type casts FK }
not(m_delphi in current_settings.modeswitches)) or
(cs_check_range in current_settings.localswitches) then
(cs_check_range in current_settings.localswitches) or
forcerangecheck then
Message(parser_e_range_check_error)
else
Message(parser_w_range_check_error);

2
compiler/ncnv.pas
View File

@ -2266,7 +2266,7 @@ implementation
{$endif VER2_2}
end
else
testrange(resultdef,tordconstnode(left).value,(nf_explicit in flags));
testrange(resultdef,tordconstnode(left).value,(nf_explicit in flags),false);
left.resultdef:=resultdef;
tordconstnode(left).typedef:=resultdef;
result:=left;

2
compiler/ncon.pas
View File

@ -669,7 +669,7 @@ implementation
{ only do range checking when explicitly asked for it
and if the type can be range checked, see tests/tbs/tb0539.pp }
if (resultdef.typ in [orddef,enumdef]) then
testrange(resultdef,value,not rangecheck)
testrange(resultdef,value,not rangecheck,false)
end;
function tordconstnode.pass_1 : tnode;

4
compiler/ninl.pas
View File

@ -1996,9 +1996,9 @@ implementation
(index.left.nodetype = ordconstn) and
not is_special_array(unpackedarraydef) then
begin
testrange(unpackedarraydef,tordconstnode(index.left).value,false);
testrange(unpackedarraydef,tordconstnode(index.left).value,false,false);
tempindex := tordconstnode(index.left).value + packedarraydef.highrange-packedarraydef.lowrange;
testrange(unpackedarraydef,tempindex,false);
testrange(unpackedarraydef,tempindex,false,false);
end;
end;

27
compiler/pstatmnt.pas
View File

@ -205,8 +205,8 @@ implementation
CGMessage(parser_e_case_lower_less_than_upper_bound);
if not casedeferror then
begin
testrange(casedef,hl1,false);
testrange(casedef,hl2,false);
testrange(casedef,hl1,false,false);
testrange(casedef,hl2,false,false);
end;
end
else
@ -234,7 +234,7 @@ implementation
begin
hl1:=get_ordinal_value(p);
if not casedeferror then
testrange(casedef,hl1,false);
testrange(casedef,hl1,false,false);
casenode.addlabel(blockid,hl1,hl1);
end;
end;
@ -321,20 +321,11 @@ implementation
function for_statement : tnode;
procedure check_range(hp:tnode);
procedure check_range(hp:tnode; fordef: tdef);
begin
{$ifndef cpu64bitaddr}
if hp.nodetype=ordconstn then
begin
if (tordconstnode(hp).value<int64(low(longint))) or
(tordconstnode(hp).value>high(longint)) then
begin
CGMessage(parser_e_range_check_error);
{ recover, prevent more warnings/errors }
tordconstnode(hp).value:=0;
end;
end;
{$endif not cpu64bitaddr}
if (hp.nodetype=ordconstn) and
(fordef.typ<>errordef) then
testrange(fordef,tordconstnode(hp).value,false,true);
end;
function for_loop_create(hloopvar: tnode): tnode;
@ -447,8 +438,8 @@ implementation
consume(_DO);
{ Check if the constants fit in the range }
check_range(hfrom);
check_range(hto);
check_range(hfrom,hloopvar.resultdef);
check_range(hto,hloopvar.resultdef);
{ first set the varstate for from and to, so
uses of loopvar in those expressions will also

2
compiler/ptconst.pas
View File

@ -251,7 +251,7 @@ implementation
begin
if is_constintnode(n) then
begin
testrange(def,tordconstnode(n).value,false);
testrange(def,tordconstnode(n).value,false,false);
case def.size of
1 :
list.concat(Tai_const.Create_8bit(byte(tordconstnode(n).value.svalue)));

14
tests/webtbf/tw17646a.pp Normal file
View File

@ -0,0 +1,14 @@
{ %fail }
program forrangecheck;
var
i1: Word;
i2: LongWord;
i3: QWord;
cnt: longint;
begin
cnt:=0;
for i1 := High(longword)-2 to High(longword) do
inc(cnt);
end.

68
tests/webtbs/tw17646.pp Normal file
View File

@ -0,0 +1,68 @@
program forrangecheck;
var
i1: Word;
i2: LongWord;
i3: QWord;
cnt: longint;
begin
cnt:=0;
for i1 := High(i1)-2 to High(i1) do
inc(cnt);
if cnt<>3 then
halt(1);
cnt:=0;
for i2 := high(i2)-2 to High(i2) do
inc(cnt);
if cnt<>3 then
halt(2);
{$ifdef cpu64}
cnt:=0;
for i3 := high(i3)-2 to High(i3) do
inc(cnt);
if cnt<>3 then
halt(3);
{$endif}
cnt:=0;
for i1 := high(word)-2 to High(Word) do
inc(cnt);
if cnt<>3 then
halt(4);
cnt:=0;
for i2 := high(longword)-2 to High(LongWord) do
inc(cnt);
if cnt<>3 then
halt(5);
{$ifdef cpu64}
cnt:=0;
for i3 := high(qword)-2 to High(QWord) do
inc(cnt);
if cnt<>3 then
halt(6);
{$endif}
cnt:=0;
for i1 := word($ffff)-2 to Word($FFFF) do
inc(cnt);
if cnt<>3 then
halt(7);
cnt:=0;
for i2 := longword($ffffffff)-2 to LongWord($FFFFFFFF) do
inc(cnt);
if cnt<>3 then
halt(8);
{$ifdef cpu64}
cnt:=0;
for i3 := QWord($FFFFFFFFFFFFFFFF)-2 to QWord($FFFFFFFFFFFFFFFF) do
inc(cnt);
if cnt<>3 then
halt(9);
{$endif}
end.