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

compiler: don't allow to assign to for-in loop variable (bug #0025318)

Browse Source 
git-svn-id: trunk@26108 -
This commit is contained in:
paul 2013-11-19 05:29:37 +00:00
parent 0020a2ed10
commit 6e7cc22207
4 changed files with 58 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -12502,6 +12502,7 @@ tests/webtbf/tw24588.pp svneol=native#text/pascal
tests/webtbf/tw2478.pp svneol=native#text/plain
tests/webtbf/tw25029.pp svneol=native#text/pascal
tests/webtbf/tw25215.pp svneol=native#text/pascal
tests/webtbf/tw25318.pp svneol=native#text/pascal
tests/webtbf/tw2562.pp svneol=native#text/plain
tests/webtbf/tw2657.pp svneol=native#text/plain
tests/webtbf/tw2670.pp svneol=native#text/plain
@ -13647,6 +13648,7 @@ tests/webtbs/tw25198.pp svneol=native#text/plain
tests/webtbs/tw25210.pp svneol=native#text/pascal
tests/webtbs/tw2525.pp svneol=native#text/plain
tests/webtbs/tw25269.pp svneol=native#text/pascal
tests/webtbs/tw25318.pp svneol=native#text/pascal
tests/webtbs/tw2536.pp svneol=native#text/plain
tests/webtbs/tw2540.pp svneol=native#text/plain
tests/webtbs/tw2561.pp svneol=native#text/plain

49
compiler/pstatmnt.pas
View File

@ -336,6 +336,24 @@ implementation
result:=cwhilerepeatnode.create(p_e,p_a,true,false);
end;
{ a helper function which is used both by "with" and "for-in loop" nodes }
function skip_nodes_before_load(p: tnode): tnode;
begin
{ ignore nodes that don't add instructions in the tree }
while assigned(p) and
{ equal type conversions }
(
(p.nodetype=typeconvn) and
(ttypeconvnode(p).convtype=tc_equal)
) or
{ constant array index }
(
(p.nodetype=vecn) and
(tvecnode(p).right.nodetype=ordconstn)
) do
p:=tunarynode(p).left;
result:=p;
end;
function for_statement : tnode;
@ -487,8 +505,18 @@ implementation
function for_in_loop_create(hloopvar: tnode): tnode;
var
expr: tnode;
expr,hloopbody,hp: tnode;
loopvarsym: tabstractvarsym;
begin
hp:=skip_nodes_before_load(hloopvar);
if assigned(hp)and(hp.nodetype=loadn) then
begin
loopvarsym:=tabstractvarsym(tloadnode(hp).symtableentry);
include(loopvarsym.varoptions,vo_is_loop_counter);
end
else
loopvarsym:=nil;
expr:=comp_expr(true,false);
consume(_DO);
@ -496,7 +524,10 @@ implementation
set_varstate(hloopvar,vs_written,[]);
set_varstate(hloopvar,vs_read,[vsf_must_be_valid]);
result:=create_for_in_loop(hloopvar,statement,expr);
hloopbody:=statement;
if assigned(loopvarsym) then
exclude(loopvarsym.varoptions,vo_is_loop_counter);
result:=create_for_in_loop(hloopvar,hloopbody,expr);
expr.free;
end;
@ -585,19 +616,7 @@ implementation
valuenode:=nil;
tempnode:=nil;
{ ignore nodes that don't add instructions in the tree }
hp:=p;
while { equal type conversions }
(
(hp.nodetype=typeconvn) and
(ttypeconvnode(hp).convtype=tc_equal)
) or
{ constant array index }
(
(hp.nodetype=vecn) and
(tvecnode(hp).right.nodetype=ordconstn)
) do
hp:=tunarynode(hp).left;
hp:=skip_nodes_before_load(p);
if (hp.nodetype=loadn) and
(
(tloadnode(hp).symtable=current_procinfo.procdef.localst) or

10
tests/webtbf/tw25318.pp Normal file
View File

@ -0,0 +1,10 @@
{%FAIL}
{$mode objfpc}
var
A: array[1..10] of Integer;
E: Integer;
begin
for E in A do
E:=1;
end.

12
tests/webtbs/tw25318.pp Normal file
View File

@ -0,0 +1,12 @@
{%NORUN}
{$mode objfpc}
type
PInteger = ^Integer;
var
A: array[1..10] of PInteger;
E: PInteger;
begin
for E in A do
E^:=1;
end.