paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 15:39:24 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ tfornode.simply which removes for loops being never executed

Browse Source 
* handle function results correctly in life dfa
* handle for loops with at least one iteration better in life dfa
o resolves #8151

git-svn-id: trunk@11624 -
This commit is contained in:
florian 2008-08-21 21:38:50 +00:00
parent 512ffe26f5
commit 1c0bd054f4
10 changed files with 182 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
.gitattributes vendored
View File

@ -8111,6 +8111,8 @@ tests/webtbf/tw11295b.pp svneol=native#text/plain
tests/webtbf/tw1157a.pp svneol=native#text/plain
tests/webtbf/tw11619b.pp svneol=native#text/plain
tests/webtbf/tw11632.pp svneol=native#text/plain
tests/webtbf/tw11846.pp svneol=native#text/plain
tests/webtbf/tw11846c.pp svneol=native#text/plain
tests/webtbf/tw11848a.pp svneol=native#text/plain
tests/webtbf/tw11849a.pp svneol=native#text/plain
tests/webtbf/tw11862a.pp svneol=native#text/plain
@ -8300,6 +8302,8 @@ tests/webtbf/tw8150c.pp svneol=native#text/plain
tests/webtbf/tw8150e.pp svneol=native#text/plain
tests/webtbf/tw8150f.pp svneol=native#text/plain
tests/webtbf/tw8150g.pp svneol=native#text/plain
tests/webtbf/tw8151b.pp svneol=native#text/plain
tests/webtbf/tw8151c.pp svneol=native#text/plain
tests/webtbf/tw8264a.pp svneol=native#text/plain
tests/webtbf/tw8398.pp svneol=native#text/plain
tests/webtbf/tw8451.pp svneol=native#text/plain
@ -8549,7 +8553,8 @@ tests/webtbs/tw1157.pp svneol=native#text/plain
tests/webtbs/tw1157b.pp svneol=native#text/plain
tests/webtbs/tw11619.pp svneol=native#text/plain
tests/webtbs/tw1181.pp svneol=native#text/plain
tests/webtbs/tw11846.pp svneol=native#text/plain
tests/webtbs/tw11846a.pp svneol=native#text/plain
tests/webtbs/tw11846b.pp svneol=native#text/plain
tests/webtbs/tw11848.pp svneol=native#text/plain
tests/webtbs/tw11849.pp svneol=native#text/plain
tests/webtbs/tw11852.pp svneol=native#text/plain
@ -9315,6 +9320,7 @@ tests/webtbs/tw8145.pp svneol=native#text/plain
tests/webtbs/tw8148.pp svneol=native#text/plain
tests/webtbs/tw8150a.pp svneol=native#text/plain
tests/webtbs/tw8150d.pp svneol=native#text/plain
tests/webtbs/tw8151a.pp svneol=native#text/plain
tests/webtbs/tw8153.pp svneol=native#text/plain
tests/webtbs/tw8153a.pp svneol=native#text/plain
tests/webtbs/tw8155.pp svneol=native#text/plain

21
compiler/nflw.pas
View File

@ -101,6 +101,7 @@ interface
procedure loop_var_access(not_type:Tnotification_flag;symbol:Tsym);
function pass_typecheck:tnode;override;
function pass_1 : tnode;override;
function simplify : tnode;override;
end;
tfornodeclass = class of tfornode;
@ -764,6 +765,26 @@ implementation
Tabstractvarsym(symbol).unregister_notification(loopvar_notid);
end;
function tfornode.simplify : tnode;
begin
result:=nil;
if (t1.nodetype=ordconstn) and
(right.nodetype=ordconstn) and
(
(
(lnf_backward in loopflags) and
(tordconstnode(right).value<tordconstnode(t1).value)
) or
(
not(lnf_backward in loopflags) and
(tordconstnode(right).value>tordconstnode(t1).value)
)
) then
result:=cnothingnode.create;
end;
function tfornode.pass_typecheck:tnode;
var
unrollres : tnode;

67
compiler/optdfa.pas
View File

@ -204,8 +204,20 @@ unit optdfa;
end
else
begin
l:=n.optinfo^.use;
DFASetIncludeSet(l,n.optinfo^.life);
{ last node, not exit or raise node and function? }
if assigned(resultnode) and
not(node.nodetype in [raisen,exitn]) then
begin
{ if yes, result lifes }
DFASetDiff(l,resultnode.optinfo^.life,n.optinfo^.def);
DFASetIncludeSet(l,n.optinfo^.use);
DFASetIncludeSet(l,n.optinfo^.life);
end
else
begin
l:=n.optinfo^.use;
DFASetIncludeSet(l,n.optinfo^.life);
end;
end;
updatelifeinfo(n,l);
end;
@ -275,7 +287,9 @@ unit optdfa;
t1: to
t2: body
}
calclife(node);
{ take care of the sucessor if it's possible that we don't have one execution of the body }
if not((tfornode(node).right.nodetype=ordconstn) and (tfornode(node).t1.nodetype=ordconstn)) then
calclife(node);
node.allocoptinfo;
if not(assigned(node.optinfo^.def)) and
not(assigned(node.optinfo^.use)) then
@ -287,9 +301,11 @@ unit optdfa;
foreachnodestatic(pm_postprocess,tfornode(node).right,@AddDefUse,@dfainfo);
foreachnodestatic(pm_postprocess,tfornode(node).t1,@AddDefUse,@dfainfo);
end;
calclife(node);
{ take care of the sucessor if it's possible that we don't have one execution of the body }
if not((tfornode(node).right.nodetype=ordconstn) and (tfornode(node).t1.nodetype=ordconstn)) then
calclife(node);
{ create life the body }
{ create life for the body }
CreateInfo(tfornode(node).t2);
{ update for node }
@ -360,7 +376,12 @@ unit optdfa;
DFASetIncludeSet(l,tifnode(node).t1.optinfo^.life)
else
if assigned(node.successor) then
DFASetIncludeSet(l,node.successor.optinfo^.life);
DFASetIncludeSet(l,node.successor.optinfo^.life)
{ last node and function? }
else
if assigned(resultnode) then
DFASetIncludeSet(l,resultnode.optinfo^.life);
{ add use info from the cond. expression }
DFASetIncludeSet(l,tifnode(node).optinfo^.use);
{ finally, update the life info of the node }
@ -397,7 +418,11 @@ unit optdfa;
DFASetIncludeSet(l,tcasenode(node).elseblock.optinfo^.life)
else
if assigned(node.successor) then
DFASetIncludeSet(l,node.successor.optinfo^.life);
DFASetIncludeSet(l,node.successor.optinfo^.life)
{ last node and function? }
else
if assigned(resultnode) then
DFASetIncludeSet(l,resultnode.optinfo^.life);
{ add use info from the "case" expression }
DFASetIncludeSet(l,tcasenode(node).optinfo^.use);
@ -502,6 +527,7 @@ unit optdfa;
dfarec.def:=@resultnode.optinfo^.def;
dfarec.map:=map;
AddDefUse(resultnode,@dfarec);
resultnode.optinfo^.life:=resultnode.optinfo^.use;
end
else
resultnode:=nil;
@ -530,40 +556,13 @@ unit optdfa;
procedure TDFABuilder.createdfainfo(node : tnode);
{
var
lastnode : tnode;
fakeexitnode : texitnode;
}
begin
if not(assigned(nodemap)) then
nodemap:=TIndexedNodeSet.Create;
{ add controll flow information }
SetNodeSucessors(node);
{
{ create an exit node for functions to get
the function result at the end handled properly }
if not(is_void(current_procinfo.procdef.returndef)) and
not(current_procinfo.procdef.proctypeoption=potype_constructor) then
begin
lastnode:=node;
while assigned(lastnode.successor) do
lastnode:=lastnode.successor;
fakeexitnode:=cexitnode.create(nil);
lastnode.successor:=fakeexitnode;
end
else
fakeexitnode:=nil;
}
{ now, collect life information }
CreateLifeInfo(node,nodemap);
{
if assigned(fakeexitnode) then
begin
lastnode.successor.free;
lastnode.successor:=nil;
end;
}
end;

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

@ -0,0 +1,14 @@
{ %OPT=-Sew -Oodfa }
{ %NORUN }
{ %fail }
{$mode objfpc}
function Test(a: integer): boolean;
var
i: Integer;
begin
for i:=1 to a do
Result:=true;
end;
begin
end.

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

@ -0,0 +1,14 @@
{ %OPT=-Sew -Oodfa }
{ %NORUN }
{ %fail }
{$mode objfpc}
function Test(a: integer): boolean;
var
i: Integer;
begin
for i:=2 to 1 do
Result:=true;
end;
begin
end.

21
tests/webtbf/tw8151b.pp Normal file
View File

@ -0,0 +1,21 @@
{ %opt=-Oodfa -Sew } program FunctionResultAnalysisWrong;
{ %fail }
{$IFDEF FPC}
{$mode delphi}
{$ENDIF}
uses
SysUtils;
var
I : longint;
function Test3: Integer;
begin
if i > 0 then
raise Exception.Create('')
end; {SHOULD generate "Warning: Function result does not seem to be set", and does in both delphi and FPC}
begin
i:=1;
end.

22
tests/webtbf/tw8151c.pp Normal file
View File

@ -0,0 +1,22 @@
{ %opt=-Oodfa -Sew } program FunctionResultAnalysisWrong;
{ %fail }
{$IFDEF FPC}
{$mode delphi}
{$ENDIF}
uses
SysUtils;
var
I : longint;
function Test5: Integer;
begin
if i > 0 then
Result := 0;
end; {SHOULD generate "Warning: Function result does not seem to be set", does in delphi, not in FPC }
begin
i:=1;
end.

0
tests/webtbs/tw11846.pp → tests/webtbs/tw11846a.pp
View File

14
tests/webtbs/tw11846b.pp Normal file
View File

@ -0,0 +1,14 @@
{ %OPT=-Sew -Oodfa }
{ %NORUN }
{$mode objfpc}
function Test(a: integer): boolean;
var
i: Integer;
begin
for i:=2 to 1 do
Result:=true;
Result:=true;
end;
begin
end.

36
tests/webtbs/tw8151a.pp Normal file
View File

@ -0,0 +1,36 @@
{ %opt=-Oodfa -Sew } program FunctionResultAnalysisWrong;
{ %norun }
{$IFDEF FPC}
{$mode delphi}
{$ENDIF}
uses
SysUtils;
var
I : longint;
function Test1: Integer;
begin
raise Exception.Create('');
end; {should NOT generate "Warning: Function result does not seem to be set" (doesn't in delphi, does in FPC) }
function Test2: Integer;
begin
if i > 0 then
raise Exception.Create('')
else
raise Exception.Create('');
end; {should NOT generate "Warning: Function result does not seem to be set" (doesn't in delphi, does in FPC) }
function Test4: Integer;
begin
if i > 0 then
raise Exception.Create('')
else
Result := 0;
end; {should NOT generate "Warning: Function result does not seem to be set" (doesn't in delphi and FPC) }
begin
i:=1;
end.