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

* run CheckAndWarn to get proper locations for warnings about uninitialized variables

Browse Source 
* several fixes to liveness analysis
* get rid of old version defines
+ tests

git-svn-id: trunk@26159 -
This commit is contained in:
florian 2013-12-01 17:01:51 +00:00
parent c357212b45
commit 99eadb91b3
25 changed files with 666 additions and 136 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
.gitattributes vendored
View File

@ -10842,8 +10842,22 @@ tests/test/opt/tcse3.pp svneol=native#text/plain
tests/test/opt/tcse4.pp svneol=native#text/pascal
tests/test/opt/tcse5.pp svneol=native#text/pascal
tests/test/opt/tdfa1.pp svneol=native#text/pascal
tests/test/opt/tdfa10.pp svneol=native#text/pascal
tests/test/opt/tdfa11.pp svneol=native#text/pascal
tests/test/opt/tdfa12.pp svneol=native#text/pascal
tests/test/opt/tdfa13.pp svneol=native#text/pascal
tests/test/opt/tdfa14.pp svneol=native#text/pascal
tests/test/opt/tdfa15.pp svneol=native#text/pascal
tests/test/opt/tdfa16.pp svneol=native#text/pascal
tests/test/opt/tdfa17.pp svneol=native#text/pascal
tests/test/opt/tdfa2.pp svneol=native#text/pascal
tests/test/opt/tdfa3.pp svneol=native#text/pascal
tests/test/opt/tdfa4.pp svneol=native#text/pascal
tests/test/opt/tdfa5.pp svneol=native#text/pascal
tests/test/opt/tdfa6.pp svneol=native#text/pascal
tests/test/opt/tdfa7.pp svneol=native#text/pascal
tests/test/opt/tdfa8.pp svneol=native#text/pascal
tests/test/opt/tdfa9.pp svneol=native#text/pascal
tests/test/opt/tgotoreg.pp svneol=native#text/plain
tests/test/opt/treg1.pp svneol=native#text/plain
tests/test/opt/treg2.pp svneol=native#text/plain

4
compiler/globals.pas
View File

@ -560,11 +560,7 @@ implementation
macutils,
{$endif}
{$ifdef mswindows}
{$ifdef VER2_4}
cwindirs,
{$else VER2_4}
windirs,
{$endif VER2_4}
{$endif}
comphook;

4
compiler/nadd.pas
View File

@ -572,11 +572,7 @@ implementation
result := left.getcopy;
end;
end
{$ifdef VER2_2}
else if (tordconstnode(right).value.svalue = -1) and (tordconstnode(right).value.signed) then
{$else}
else if tordconstnode(right).value = -1 then
{$endif}
begin
case nodetype of
muln:

17
compiler/nbas.pas
View File

@ -442,14 +442,17 @@ implementation
exit;
end;
{ if the current statement contains a block with one statement, }
{ replace the current statement with that block's statement }
{ (but only if the block does not have nf_block_with_exit set }
{ or has no exit statement, because otherwise it needs an own }
{ exit label, see tests/test/tinline10) }
{ if the current statement contains a block with one statement,
replace the current statement with that block's statement
(but only if the block does not have nf_block_with_exit set
or has no exit statement, because otherwise it needs an own
exit label, see tests/test/tinline10)
Further, it might not be the user code entry
}
if (left.nodetype = blockn) and
(not(nf_block_with_exit in left.flags) or
no_exit_statement_in_block(left)) and
((left.flags*[nf_block_with_exit,nf_usercode_entry]=[]) or
((left.flags*[nf_block_with_exit,nf_usercode_entry]=[nf_block_with_exit]) and no_exit_statement_in_block(left))) and
assigned(tblocknode(left).left) and
not assigned(tstatementnode(tblocknode(left).left).right) then
begin

5
compiler/ncnv.pas
View File

@ -2691,12 +2691,7 @@ implementation
if is_pasbool(resultdef) then
tordconstnode(left).value:=ord(tordconstnode(left).value<>0)
else
{$ifdef VER2_2}
tordconstnode(left).value:=ord(tordconstnode(left).value<>0);
tordconstnode(left).value:=-tordconstnode(left).value;
{$else}
tordconstnode(left).value:=-ord(tordconstnode(left).value<>0);
{$endif VER2_2}
end
else
testrange(resultdef,tordconstnode(left).value,(nf_explicit in flags),false);

11
compiler/ncon.pas
View File

@ -201,6 +201,8 @@ interface
function is_emptyset(p : tnode):boolean;
function genconstsymtree(p : tconstsym) : tnode;
function getbooleanvalue(p : tnode) : boolean;
implementation
uses
@ -332,6 +334,15 @@ implementation
end;
function getbooleanvalue(p : tnode) : boolean;
begin
if is_constboolnode(p) then
result:=tordconstnode(p).value<>0
else
internalerror(2013111601);
end;
{*****************************************************************************
TDATACONSTNODE
*****************************************************************************}

1
compiler/nflw.pas
View File

@ -114,6 +114,7 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
function pass_typecheck:tnode;override;
function pass_1 : tnode;override;
property resultexpr : tnode read left write left;
end;
texitnodeclass = class of texitnode;

14
compiler/optbase.pas
View File

@ -55,6 +55,9 @@ unit optbase;
{ add s to d }
procedure DFASetIncludeSet(var d : tdfaset;const s : tdfaset);
{ remove s to d }
procedure DFASetExcludeSet(var d : tdfaset;const s : tdfaset);
{ remove e from s }
procedure DFASetExclude(var s : tdfaset;e : integer);
@ -103,6 +106,17 @@ unit optbase;
end;
procedure DFASetExcludeSet(var d : tdfaset;const s : tdfaset);
var
i : integer;
begin
if length(s)>length(d) then
SetLength(d,length(s));
for i:=0 to high(s) do
d[i]:=d[i] and not(s[i]);
end;
procedure DFASetExclude(var s : tdfaset;e : integer);
var
e8 : Integer;

428
compiler/optdfa.pas
View File

@ -48,17 +48,19 @@ unit optdfa;
destructor destroy;override;
end;
procedure CheckAndWarn(code : tnode;nodetosearch : tnode);
implementation
uses
globtype,globals,
verbose,
cpuinfo,
symconst,symdef,
symconst,symdef,symsym,
defutil,
procinfo,
nutils,
nbas,nflw,ncon,ninl,ncal,nset,
nbas,nflw,ncon,ninl,ncal,nset,nld,nadd,
optbase;
@ -126,13 +128,6 @@ unit optdfa;
DFASetInclude(pdfainfo(arg)^.def^,n.optinfo^.index)
else
DFASetInclude(pdfainfo(arg)^.use^,n.optinfo^.index);
{
write('Use Set: ');
PrintDFASet(output,pdfainfo(arg)^.use^);
write(' Def Set: ');
PrintDFASet(output,pdfainfo(arg)^.def^);
writeln;
}
end;
end;
result:=fen_false;
@ -177,16 +172,6 @@ unit optdfa;
b : boolean;
begin
b:=DFASetNotEqual(l,n.optinfo^.life);
{
if b then
begin
printnode(output,n);
printdfaset(output,l);
writeln;
printdfaset(output,n.optinfo^.life);
writeln;
end;
}
{$ifdef DEBUG_DFA}
if not(changed) and b then
begin
@ -236,11 +221,6 @@ unit optdfa;
exit;
include(node.flags,nf_processing);
if not(assigned(node.successor)) and (node<>resultnode) and
not((node.nodetype=calln) and (cnf_call_never_returns in tcallnode(node).callnodeflags)) and
not(node.nodetype in [raisen,exitn]) then
node.successor:=resultnode;
if assigned(node.successor) then
CreateInfo(node.successor);
@ -327,7 +307,7 @@ unit optdfa;
if left is a record element, it might not be tracked by dfa, so
optinfo might not be assigned
}
counteruse_after_loop:=assigned(tfornode(node).left.optinfo) and
counteruse_after_loop:=assigned(tfornode(node).left.optinfo) and assigned(node.successor) and
DFASetIn(node.successor.optinfo^.life,tfornode(node).left.optinfo^.index);
{ if yes, then we should warn }
@ -339,7 +319,8 @@ unit optdfa;
l:=copy(tfornode(node).t2.optinfo^.life);
{ take care of the sucessor }
DFASetIncludeSet(l,node.successor.optinfo^.life);
if assigned(node.successor) then
DFASetIncludeSet(l,node.successor.optinfo^.life);
{ the counter variable is living as well inside the for loop
@ -358,7 +339,8 @@ unit optdfa;
l:=copy(tfornode(node).t2.optinfo^.life);
{ take care of the sucessor as it's possible that we don't have one execution of the body }
if not(tfornode(node).right.nodetype=ordconstn) or not(tfornode(node).t1.nodetype=ordconstn) then
if (not(tfornode(node).right.nodetype=ordconstn) or not(tfornode(node).t1.nodetype=ordconstn)) and
assigned(node.successor) then
DFASetIncludeSet(l,node.successor.optinfo^.life);
{
@ -436,19 +418,19 @@ unit optdfa;
{ get life info from then branch }
if assigned(tifnode(node).right) then
DFASetIncludeSet(l,tifnode(node).right.optinfo^.life);
{ get life info from else branch }
if assigned(tifnode(node).t1) then
DFASetIncludeSet(l,tifnode(node).t1.optinfo^.life)
else
if assigned(node.successor) then
DFASetIncludeSet(l,node.successor.optinfo^.life)
{ last node and function? }
else
if assigned(resultnode) then
DFASetIncludeSet(l,resultnode.optinfo^.life);
else if assigned(node.successor) then
DFASetIncludeSet(l,node.successor.optinfo^.life);
{ remove def info from the cond. expression }
DFASetExcludeSet(l,tifnode(node).optinfo^.def);
{ add use info from the cond. expression }
DFASetIncludeSet(l,tifnode(node).optinfo^.use);
{ finally, update the life info of the node }
UpdateLifeInfo(node,l);
end;
@ -481,13 +463,8 @@ unit optdfa;
{ get life info from else branch or the succesor }
if assigned(tcasenode(node).elseblock) then
DFASetIncludeSet(l,tcasenode(node).elseblock.optinfo^.life)
else
if assigned(node.successor) then
DFASetIncludeSet(l,node.successor.optinfo^.life)
{ last node and function? }
else
if assigned(resultnode) then
DFASetIncludeSet(l,resultnode.optinfo^.life);
else if assigned(node.successor) then
DFASetIncludeSet(l,node.successor.optinfo^.life);
{ add use info from the "case" expression }
DFASetIncludeSet(l,tcasenode(node).optinfo^.use);
@ -559,46 +536,21 @@ unit optdfa;
calclife(node);
end;
else
if node<>resultnode then
begin
writeln(nodetype2str[node.nodetype]);
internalerror(2007050502);
end;
internalerror(2007050502);
end;
// exclude(node.flags,nf_processing);
end;
var
runs : integer;
dfarec : tdfainfo;
begin
runs:=0;
if not(is_void(current_procinfo.procdef.returndef)) then
begin
{ create a fake node using the result }
if current_procinfo.procdef.proctypeoption=potype_constructor then
resultnode:=load_self_node
else
resultnode:=load_result_node;
resultnode.allocoptinfo;
dfarec.use:=@resultnode.optinfo^.use;
dfarec.def:=@resultnode.optinfo^.def;
dfarec.map:=map;
AddDefUse(resultnode,@dfarec);
resultnode.optinfo^.life:=resultnode.optinfo^.use;
end
else
begin
resultnode:=cnothingnode.create;
resultnode.allocoptinfo;
end;
repeat
inc(runs);
changed:=false;
CreateInfo(node);
foreachnodestatic(pm_postprocess,node,@ResetProcessing,nil);
{ the result node is not reached by foreachnodestatic }
exclude(resultnode.flags,nf_processing);
{$ifdef DEBUG_DFA}
PrintIndexedNodeSet(output,map);
PrintDFAInfo(output,node);
@ -619,11 +571,35 @@ unit optdfa;
procedure TDFABuilder.createdfainfo(node : tnode);
var
dfarec : tdfainfo;
begin
if not(assigned(nodemap)) then
nodemap:=TIndexedNodeSet.Create;
{ create a fake node using the result which will be the last node }
if not(is_void(current_procinfo.procdef.returndef)) then
begin
if current_procinfo.procdef.proctypeoption=potype_constructor then
resultnode:=load_self_node
else
resultnode:=load_result_node;
resultnode.allocoptinfo;
dfarec.use:=@resultnode.optinfo^.use;
dfarec.def:=@resultnode.optinfo^.def;
dfarec.map:=nodemap;
AddDefUse(resultnode,@dfarec);
resultnode.optinfo^.life:=resultnode.optinfo^.use;
end
else
begin
resultnode:=cnothingnode.create;
resultnode.allocoptinfo;
end;
{ add controll flow information }
SetNodeSucessors(node,resultnode);
{ now, collect life information }
CreateLifeInfo(node,nodemap);
end;
@ -636,4 +612,318 @@ unit optdfa;
inherited destroy;
end;
var
{ we have to pass the address of SearchNode in a call inside of SearchNode:
@SearchNode does not work because the compiler thinks we take the address of the result
so store the address from outside }
SearchNodeProcPointer : function(var n: tnode; arg: pointer): foreachnoderesult;
type
{ helper structure to be able to pass more than one variable to the iterator function }
TSearchNodeInfo = record
nodetosearch : tnode;
{ this contains a list of all file locations where a warning was thrown already,
the same location might appear multiple times because nodes might have been copied }
warnedfilelocs : array of tfileposinfo;
end;
PSearchNodeInfo = ^TSearchNodeInfo;
{ searches for a given node n and warns if the node is found as being uninitialized. If a node is
found, searching is stopped so each call issues only one warning/hint }
function SearchNode(var n: tnode; arg: pointer): foreachnoderesult;
function WarnedForLocation(f : tfileposinfo) : boolean;
var
i : longint;
begin
result:=true;
for i:=0 to high(PSearchNodeInfo(arg)^.warnedfilelocs) do
with PSearchNodeInfo(arg)^.warnedfilelocs[i] do
begin
if (f.column=column) and (f.fileindex=fileindex) and (f.line=line) and (f.moduleindex=moduleindex) then
exit;
end;
result:=false;
end;
procedure AddFilepos(const f : tfileposinfo);
begin
Setlength(PSearchNodeInfo(arg)^.warnedfilelocs,length(PSearchNodeInfo(arg)^.warnedfilelocs)+1);
PSearchNodeInfo(arg)^.warnedfilelocs[high(PSearchNodeInfo(arg)^.warnedfilelocs)]:=f;
end;
var
varsym : tabstractnormalvarsym;
methodpointer,
hpt : tnode;
begin
result:=fen_false;
case n.nodetype of
callparan:
begin
{ do not warn about variables passed by var, just issue a hint, this
is a workaround for old code e.g. using fillchar }
if assigned(tcallparanode(n).parasym) and (tcallparanode(n).parasym.varspez in [vs_var,vs_out]) then
begin
hpt:=tcallparanode(n).left;
while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn,typeconvn]) do
hpt:=tunarynode(hpt).left;
if assigned(hpt) and (hpt.nodetype=loadn) and not(WarnedForLocation(hpt.fileinfo)) and
{ warn only on the current symtable level }
(((tabstractnormalvarsym(tloadnode(hpt).symtableentry).owner=current_procinfo.procdef.localst) and
(current_procinfo.procdef.localst.symtablelevel=tabstractnormalvarsym(tloadnode(hpt).symtableentry).owner.symtablelevel)
) or
((tabstractnormalvarsym(tloadnode(hpt).symtableentry).owner=current_procinfo.procdef.parast) and
(current_procinfo.procdef.parast.symtablelevel=tabstractnormalvarsym(tloadnode(hpt).symtableentry).owner.symtablelevel)
)
) and
PSearchNodeInfo(arg)^.nodetosearch.isequal(hpt) then
begin
{ issue only a hint for var, when encountering the node passed as out, we need only to stop searching }
if tcallparanode(n).parasym.varspez=vs_var then
MessagePos1(hpt.fileinfo,sym_h_uninitialized_local_variable,tloadnode(hpt).symtableentry.RealName);
AddFilepos(hpt.fileinfo);
result:=fen_norecurse_true;
end
end;
end;
orn,
andn:
begin
{ take care of short boolean evaluation: if the expression to be search is found in left,
we do not need to search right }
if foreachnodestatic(pm_postprocess,taddnode(n).left,SearchNodeProcPointer,arg) or
foreachnodestatic(pm_postprocess,taddnode(n).right,SearchNodeProcPointer,arg) then
result:=fen_norecurse_true
else
result:=fen_norecurse_false;
end;
calln:
begin
methodpointer:=tcallnode(n).methodpointer;
if assigned(methodpointer) and (methodpointer.nodetype<>typen) then
begin
{ Remove all postfix operators }
hpt:=methodpointer;
while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
hpt:=tunarynode(hpt).left;
{ skip (absolute and other simple) type conversions -- only now,
because the checks above have to take type conversions into
e.g. class reference types account }
hpt:=actualtargetnode(@hpt)^;
{ R.Init then R will be initialized by the constructor,
Also allow it for simple loads }
if (tcallnode(n).procdefinition.proctypeoption=potype_constructor) or
(PSearchNodeInfo(arg)^.nodetosearch.isequal(hpt) and
(((methodpointer.resultdef.typ=objectdef) and
not(oo_has_virtual in tobjectdef(methodpointer.resultdef).objectoptions)) or
(methodpointer.resultdef.typ=recorddef)
)
) then
begin
{ don't warn about the method pointer }
AddFilepos(hpt.fileinfo);
if not(foreachnodestatic(pm_postprocess,tcallnode(n).left,SearchNodeProcPointer,arg)) then
foreachnodestatic(pm_postprocess,tcallnode(n).right,SearchNodeProcPointer,arg);
result:=fen_norecurse_true
end;
end;
end;
loadn:
begin
if (tloadnode(n).symtableentry.typ in [localvarsym,paravarsym,staticvarsym]) and
PSearchNodeInfo(arg)^.nodetosearch.isequal(n) and ((nf_modify in n.flags) or not(nf_write in n.flags)) then
begin
varsym:=tabstractnormalvarsym(tloadnode(n).symtableentry);
{ Give warning/note for living locals, result and parameters, but only about the current
symtables }
if assigned(varsym.owner) and
(((varsym.owner=current_procinfo.procdef.localst) and
(current_procinfo.procdef.localst.symtablelevel=varsym.owner.symtablelevel)
) or
((varsym.owner=current_procinfo.procdef.parast) and
(varsym.typ=paravarsym) and
(current_procinfo.procdef.parast.symtablelevel=varsym.owner.symtablelevel) and
{ all parameters except out parameters are initialized by the caller }
(tparavarsym(varsym).varspez=vs_out)
) or
((vo_is_funcret in varsym.varoptions) and
(current_procinfo.procdef.parast.symtablelevel=varsym.owner.symtablelevel)
)
) and
not(vo_is_external in varsym.varoptions) then
begin
if (vo_is_funcret in varsym.varoptions) and not(WarnedForLocation(n.fileinfo)) then
begin
MessagePos(n.fileinfo,sym_w_function_result_uninitialized);
AddFilepos(n.fileinfo);
result:=fen_norecurse_true;
end
else
begin
{ typed consts are initialized, further, warn only once per location }
if not (vo_is_typed_const in varsym.varoptions) and not(WarnedForLocation(n.fileinfo)) then
begin
if varsym.typ=paravarsym then
MessagePos1(n.fileinfo,sym_w_uninitialized_variable,varsym.realname)
else
MessagePos1(n.fileinfo,sym_w_uninitialized_local_variable,varsym.realname);
AddFilepos(n.fileinfo);
result:=fen_norecurse_true;
end;
end;
end
{$ifdef dummy}
{ if a the variable we are looking for is passed as a var parameter, we stop searching }
else if assigned(varsym.owner) and
(varsym.owner=current_procinfo.procdef.parast) and
(varsym.typ=paravarsym) and
(current_procinfo.procdef.parast.symtablelevel=varsym.owner.symtablelevel) and
(tparavarsym(varsym).varspez=vs_var) then
result:=fen_norecurse_true;
{$endif dummy}
end;
end;
end;
end;
procedure CheckAndWarn(code : tnode;nodetosearch : tnode);
var
SearchNodeInfo : TSearchNodeInfo;
function DoCheck(node : tnode) : boolean;
var
i : longint;
touchesnode : Boolean;
procedure MaybeDoCheck(n : tnode);
begin
if not(Result) then
Result:=Result or DoCheck(n);
end;
procedure MaybeSearchIn(n : tnode);
begin
if touchesnode then
Result:=Result or foreachnodestatic(pm_postprocess,n,@SearchNode,@SearchNodeInfo);
end;
begin
result:=false;
if node=nil then
exit;
if nf_processing in node.flags then
exit;
include(node.flags,nf_processing);
touchesnode:=DFASetIn(node.optinfo^.use,nodetosearch.optinfo^.index) or
DFASetIn(node.optinfo^.def,nodetosearch.optinfo^.index);
if not(DFASetIn(node.optinfo^.life,nodetosearch.optinfo^.index)) then
exit;
case node.nodetype of
whilerepeatn:
begin
MaybeSearchIn(twhilerepeatnode(node).left);
MaybeDoCheck(twhilerepeatnode(node).right);
end;
forn:
begin
MaybeSearchIn(tfornode(node).right);
MaybeSearchIn(tfornode(node).t1);
MaybeDoCheck(tfornode(node).t2);
end;
statementn:
MaybeDoCheck(tstatementnode(node).statement);
blockn:
MaybeDoCheck(tblocknode(node).statements);
ifn:
begin
MaybeSearchIn(tifnode(node).left);
MaybeDoCheck(tifnode(node).right);
MaybeDoCheck(tifnode(node).t1);
end;
casen:
begin
MaybeSearchIn(tcasenode(node).left);
for i:=0 to tcasenode(node).blocks.count-1 do
MaybeDoCheck(pcaseblock(tcasenode(node).blocks[i])^.statement);
MaybeDoCheck(tcasenode(node).elseblock);
end;
labeln:
MaybeDoCheck(tlabelnode(node).left);
{ we are aware of the following nodes so if new node types are added to the compiler
and pop up in the search, the ie below kicks in as a reminder }
exitn:
begin
MaybeSearchIn(texitnode(node).left);
{ exit uses the resultnode implicitly, so searching for a matching node is
useless, if we reach the exit node and found the living node not in left, then
it can be only the resultnode }
if not(Result) and not(is_void(current_procinfo.procdef.returndef)) and
not(assigned(texitnode(node).resultexpr)) and
{ don't warn about constructors }
not(current_procinfo.procdef.proctypeoption in [potype_class_constructor,potype_constructor]) then
begin
MessagePos(node.fileinfo,sym_w_function_result_uninitialized);
Setlength(SearchNodeInfo.warnedfilelocs,length(SearchNodeInfo.warnedfilelocs)+1);
SearchNodeInfo.warnedfilelocs[high(SearchNodeInfo.warnedfilelocs)]:=node.fileinfo;
end
end;
{ could be the implicitly generated load node for the result }
loadn,
assignn,
calln,
temprefn,
typeconvn,
inlinen,
tempcreaten,
tempdeleten:
MaybeSearchIn(node);
nothingn,
continuen,
goton,
breakn:
;
else
internalerror(2013111301);
end;
{ if already a warning has been issued, then stop }
if Result then
exit;
if assigned(node.successor) then
MaybeDoCheck(node.successor);
end;
begin
SearchNodeInfo.nodetosearch:=nodetosearch;
DoCheck(code);
foreachnodestatic(pm_postprocess,code,@ResetProcessing,nil);
end;
begin
SearchNodeProcPointer:=@SearchNode;
end.

19
compiler/optutils.pas
View File

@ -55,7 +55,7 @@ unit optutils;
uses
verbose,
optbase,
ncal,nbas,nflw,nutils,nset;
ncal,nbas,nflw,nutils,nset,ncon;
function TIndexedNodeSet.Add(node : tnode) : boolean;
var
@ -129,6 +129,10 @@ unit optutils;
PrintDFASet(text(arg^),n.optinfo^.def);
write(text(arg^),' Use: ');
PrintDFASet(text(arg^),n.optinfo^.use);
if assigned(n.successor) then
write(text(arg^),' Successor: ',nodetype2str[n.successor.nodetype],'(',n.successor.fileinfo.line,',',n.successor.fileinfo.column,')')
else
write(text(arg^),' Successor: nil');
writeln(text(arg^));
end;
result:=fen_false;
@ -222,7 +226,18 @@ unit optutils;
result:=p;
{ the successor of the last node of the while/repeat body is the while node itself }
DoSet(twhilerepeatnode(p).right,p);
p.successor:=succ;
{ special case: we do not do a dyn. dfa, but we should handle endless loops }
if is_constboolnode(twhilerepeatnode(p).left) then
begin
if ((lnf_testatbegin in twhilerepeatnode(p).loopflags) and
getbooleanvalue(twhilerepeatnode(p).left)) or (not(lnf_testatbegin in twhilerepeatnode(p).loopflags) and
not(getbooleanvalue(twhilerepeatnode(p).left))) then
p.successor:=nil;
end;
Breakstack.Delete(Breakstack.Count-1);
Continuestack.Delete(Continuestack.Count-1);
end;
@ -306,7 +321,7 @@ unit optutils;
begin
Breakstack:=TFPList.Create;
Continuestack:=TFPList.Create;
DoSet(p,nil);
DoSet(p,last);
Continuestack.Free;
Breakstack.Free;
end;

59
compiler/psub.pas
View File

@ -1160,7 +1160,7 @@ implementation
n:=nil;
foreachnodestatic(code,@searchusercode,@n);
if not(assigned(n)) then
internalerror(2013111001);
internalerror(2013111004);
result:=n;
end;
@ -1293,51 +1293,19 @@ implementation
begin
dfabuilder:=TDFABuilder.Create;
dfabuilder.createdfainfo(code);
{ when life info is available, we can give more sophisticated warning about unintialized
variables }
{ iterate through life info of the first node }
for i:=0 to dfabuilder.nodemap.count-1 do
begin
if DFASetIn(GetUserCode.optinfo^.life,i) then
case tnode(dfabuilder.nodemap[i]).nodetype of
loadn:
begin
varsym:=tabstractnormalvarsym(tloadnode(dfabuilder.nodemap[i]).symtableentry);
{ Give warning/note for living locals, result and parameters, but only about the current
symtables }
if assigned(varsym.owner) and
(((varsym.owner=procdef.localst) and
(procdef.localst.symtablelevel=varsym.owner.symtablelevel)
) or
((varsym.owner=procdef.parast) and
(varsym.typ=paravarsym) and
(procdef.parast.symtablelevel=varsym.owner.symtablelevel) and
{ all parameters except out parameters are initialized by the caller }
(tparavarsym(varsym).varspez=vs_out)
) or
((vo_is_funcret in varsym.varoptions) and
(procdef.parast.symtablelevel=varsym.owner.symtablelevel)
)
) and
not(vo_is_external in varsym.varoptions) then
begin
if (vo_is_funcret in varsym.varoptions) then
CGMessage(sym_w_function_result_uninitialized)
else
begin
if not (vo_is_typed_const in varsym.varoptions) then
if varsym.typ=paravarsym then
CGMessage1(sym_w_uninitialized_variable,varsym.realname)
else
CGMessage1(sym_w_uninitialized_local_variable,varsym.realname);
end;
end;
end;
end;
end;
include(flags,pi_dfaavailable);
{ when life info is available, we can give more sophisticated warning about uninitialized
variables ...
... but not for the finalization section of a unit, we would need global dfa to handle
it properly }
if potype_unitfinalize<>procdef.proctypeoption then
{ iterate through life info of the first node }
for i:=0 to dfabuilder.nodemap.count-1 do
begin
if DFASetIn(GetUserCode.optinfo^.life,i) then
CheckAndWarn(GetUserCode,tnode(dfabuilder.nodemap[i]));
end;
end;
if (pi_dfaavailable in flags) and (cs_opt_dead_store_eliminate in current_settings.optimizerswitches) then
@ -1898,6 +1866,7 @@ implementation
isnestedproc : boolean;
begin
Message1(parser_d_procedure_start,pd.fullprocname(false));
oldfailtokenmode:=[];
{ create a new procedure }
current_procinfo:=cprocinfo.create(old_current_procinfo);

16
tests/test/opt/tdfa10.pp Normal file
View File

@ -0,0 +1,16 @@
{ %OPT=-Oodfa -Sew -vw -S2 }
function f(var i : longint) : boolean;
begin
result:=true;
i:=0;
end;
var
i : longint;
begin
if f(i) and (i=0) then
halt(i)
else
halt(1);
end.

16
tests/test/opt/tdfa11.pp Normal file
View File

@ -0,0 +1,16 @@
{ %OPT=-Oodfa -Sew -vw }
{ %norun }
{ this test test needs dynamic dfa to work properly,
this is a reminder so it will not be forgotten }
var
j,i : longint;
begin
j:=paramcount;
if j=1 then
i:=1;
writeln;
if j=1 then
writeln(i);
end.

16
tests/test/opt/tdfa12.pp Normal file
View File

@ -0,0 +1,16 @@
{ %OPT=-Oodfa -Sew -vw -S2 }
function f(var i : longint) : boolean;
begin
result:=true;
i:=0;
end;
var
i : longint;
begin
if f(i) or (i=0) then
halt(i)
else
halt(1);
end.

13
tests/test/opt/tdfa13.pp Normal file
View File

@ -0,0 +1,13 @@
{ %OPT=-Oodfa -Sew -vw -S2 }
{ %fail }
{ %norun }
var
j,
i : longint;
begin
j:=paramcount;
if (j=1) and (i=0) then
halt(1)
else
halt(0);
end.

13
tests/test/opt/tdfa14.pp Normal file
View File

@ -0,0 +1,13 @@
{ %OPT=-Oodfa -Sew -vw -S2 }
{ %fail }
{ %norun }
var
j,
i : longint;
begin
j:=paramcount;
if (j=1) or (i=0) then
halt(1)
else
halt(0);
end.

16
tests/test/opt/tdfa15.pp Normal file
View File

@ -0,0 +1,16 @@
{ %OPT=-Oodfa -Sew -vw -S2 }
function f(out i : longint) : boolean;
begin
result:=true;
i:=0;
end;
var
i : longint;
begin
if f(i) and (i=0) then
halt(i)
else
halt(1);
end.

14
tests/test/opt/tdfa16.pp Normal file
View File

@ -0,0 +1,14 @@
{ %OPT=-Oodfa -Sew -vw -S2 }
function f(out i : longint) : boolean;
begin
result:=true;
i:=0;
end;
var
i : longint;
begin
while f(i) do
halt(i);
end.

14
tests/test/opt/tdfa17.pp Normal file
View File

@ -0,0 +1,14 @@
{ %OPT=-Oodfa -Sew -vw -S2 }
function f(var i : longint) : boolean;
begin
result:=true;
i:=0;
end;
var
i : longint;
begin
while f(i) do
halt(i);
end.

17
tests/test/opt/tdfa4.pp Normal file
View File

@ -0,0 +1,17 @@
{ %OPT=-Oodfa -Sew -vw}
{ %NORUN}
program tdfa1;
function f(i : longint) : longint;
begin
repeat
if i>1 then
exit(3);
if i<=1 then
exit(4);
until false;
end;
begin
end.

13
tests/test/opt/tdfa5.pp Normal file
View File

@ -0,0 +1,13 @@
{ %OPT=-Oodfa -Sew -vw -S2}
{ %NORUN}
program tdfa5;
function f(i : longint) : longint;
begin
fillchar(i,sizeof(i),0);
result:=i;
end;
begin
end.

26
tests/test/opt/tdfa6.pp Normal file
View File

@ -0,0 +1,26 @@
{ %OPT=-Oodfa -Sew -vw -S2}
{ %NORUN}
program tdfa5;
function getmeandinc(var i : longint) : longint;
begin
result:=i;
inc(i);
end;
function f(i : longint) : longint;
var
j : longint;
begin
if getmeandinc(j)>i then
repeat
if j>-1 then
inc(j);
until j>i;
result:=i+j;
end;
begin
end.

18
tests/test/opt/tdfa7.pp Normal file
View File

@ -0,0 +1,18 @@
{ %OPT=-Oodfa -Sew -vw }
type
to1 = object
procedure Init;
end;
procedure to1.Init;
begin
end;
var
o1,o2 : to1;
begin
o1.Init;
o2:=o1;
end.

18
tests/test/opt/tdfa8.pp Normal file
View File

@ -0,0 +1,18 @@
{ %OPT=-Oodfa -Sew -vw }
{ %fail }
{ %norun }
unit tdfa8;
interface
implementation
{ this test will work only as soon as we have global dfa,
so this will not be forgotten to be handled properly }
var
i : longint;
initialization
finalization
writeln(i);
end.

16
tests/test/opt/tdfa9.pp Normal file
View File

@ -0,0 +1,16 @@
{ %OPT=-Oodfa -Sew -vw }
{ %norun }
unit tdfa9;
interface
implementation
var
i : longint;
initialization
i:=1;
finalization
writeln(i);
end.