Bladeren bron

* run CheckAndWarn to get proper locations for warnings about uninitialized variables
* several fixes to liveness analysis
* get rid of old version defines
+ tests

git-svn-id: trunk@26159 -

florian 11 jaren geleden
bovenliggende
commit
99eadb91b3

+ 14 - 0
.gitattributes

@@ -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/tcse4.pp svneol=native#text/pascal
 tests/test/opt/tcse5.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/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/tdfa2.pp svneol=native#text/pascal
 tests/test/opt/tdfa3.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/tgotoreg.pp svneol=native#text/plain
 tests/test/opt/treg1.pp svneol=native#text/plain
 tests/test/opt/treg1.pp svneol=native#text/plain
 tests/test/opt/treg2.pp svneol=native#text/plain
 tests/test/opt/treg2.pp svneol=native#text/plain

+ 0 - 4
compiler/globals.pas

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

+ 0 - 4
compiler/nadd.pas

@@ -572,11 +572,7 @@ implementation
                    result := left.getcopy;
                    result := left.getcopy;
                 end;
                 end;
               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
             else if tordconstnode(right).value = -1 then
-{$endif}
               begin
               begin
                 case nodetype of
                 case nodetype of
                   muln:
                   muln:

+ 10 - 7
compiler/nbas.pas

@@ -442,14 +442,17 @@ implementation
             exit;
             exit;
           end;
           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
         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
            assigned(tblocknode(left).left) and
            not assigned(tstatementnode(tblocknode(left).left).right) then
            not assigned(tstatementnode(tblocknode(left).left).right) then
           begin
           begin

+ 0 - 5
compiler/ncnv.pas

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

+ 11 - 0
compiler/ncon.pas

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

+ 1 - 0
compiler/nflw.pas

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

+ 14 - 0
compiler/optbase.pas

@@ -55,6 +55,9 @@ unit optbase;
     { add s to d }
     { add s to d }
     procedure DFASetIncludeSet(var d : tdfaset;const s : tdfaset);
     procedure DFASetIncludeSet(var d : tdfaset;const s : tdfaset);
 
 
+    { remove s to d }
+    procedure DFASetExcludeSet(var d : tdfaset;const s : tdfaset);
+
     { remove e from s }
     { remove e from s }
     procedure DFASetExclude(var s : tdfaset;e : integer);
     procedure DFASetExclude(var s : tdfaset;e : integer);
 
 
@@ -103,6 +106,17 @@ unit optbase;
       end;
       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);
     procedure DFASetExclude(var s : tdfaset;e : integer);
       var
       var
         e8 : Integer;
         e8 : Integer;

+ 359 - 69
compiler/optdfa.pas

@@ -48,17 +48,19 @@ unit optdfa;
         destructor destroy;override;
         destructor destroy;override;
       end;
       end;
 
 
+    procedure CheckAndWarn(code : tnode;nodetosearch : tnode);
+
   implementation
   implementation
 
 
     uses
     uses
       globtype,globals,
       globtype,globals,
       verbose,
       verbose,
       cpuinfo,
       cpuinfo,
-      symconst,symdef,
+      symconst,symdef,symsym,
       defutil,
       defutil,
       procinfo,
       procinfo,
       nutils,
       nutils,
-      nbas,nflw,ncon,ninl,ncal,nset,
+      nbas,nflw,ncon,ninl,ncal,nset,nld,nadd,
       optbase;
       optbase;
 
 
 
 
@@ -126,13 +128,6 @@ unit optdfa;
                 DFASetInclude(pdfainfo(arg)^.def^,n.optinfo^.index)
                 DFASetInclude(pdfainfo(arg)^.def^,n.optinfo^.index)
               else
               else
                 DFASetInclude(pdfainfo(arg)^.use^,n.optinfo^.index);
                 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;
         end;
         end;
         result:=fen_false;
         result:=fen_false;
@@ -177,16 +172,6 @@ unit optdfa;
             b : boolean;
             b : boolean;
           begin
           begin
             b:=DFASetNotEqual(l,n.optinfo^.life);
             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}
 {$ifdef DEBUG_DFA}
             if not(changed) and b then
             if not(changed) and b then
               begin
               begin
@@ -236,11 +221,6 @@ unit optdfa;
             exit;
             exit;
           include(node.flags,nf_processing);
           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
           if assigned(node.successor) then
             CreateInfo(node.successor);
             CreateInfo(node.successor);
 
 
@@ -327,7 +307,7 @@ unit optdfa;
                   if left is a record element, it might not be tracked by dfa, so
                   if left is a record element, it might not be tracked by dfa, so
                   optinfo might not be assigned
                   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);
                   DFASetIn(node.successor.optinfo^.life,tfornode(node).left.optinfo^.index);
 
 
                 { if yes, then we should warn }
                 { if yes, then we should warn }
@@ -339,7 +319,8 @@ unit optdfa;
                 l:=copy(tfornode(node).t2.optinfo^.life);
                 l:=copy(tfornode(node).t2.optinfo^.life);
 
 
                 { take care of the sucessor }
                 { 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
                 { the counter variable is living as well inside the for loop
 
 
@@ -358,7 +339,8 @@ unit optdfa;
                 l:=copy(tfornode(node).t2.optinfo^.life);
                 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 }
                 { 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);
                   DFASetIncludeSet(l,node.successor.optinfo^.life);
 
 
                 {
                 {
@@ -436,19 +418,19 @@ unit optdfa;
                 { get life info from then branch }
                 { get life info from then branch }
                 if assigned(tifnode(node).right) then
                 if assigned(tifnode(node).right) then
                   DFASetIncludeSet(l,tifnode(node).right.optinfo^.life);
                   DFASetIncludeSet(l,tifnode(node).right.optinfo^.life);
+
                 { get life info from else branch }
                 { get life info from else branch }
                 if assigned(tifnode(node).t1) then
                 if assigned(tifnode(node).t1) then
                   DFASetIncludeSet(l,tifnode(node).t1.optinfo^.life)
                   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 }
                 { add use info from the cond. expression }
                 DFASetIncludeSet(l,tifnode(node).optinfo^.use);
                 DFASetIncludeSet(l,tifnode(node).optinfo^.use);
+
                 { finally, update the life info of the node }
                 { finally, update the life info of the node }
                 UpdateLifeInfo(node,l);
                 UpdateLifeInfo(node,l);
               end;
               end;
@@ -481,13 +463,8 @@ unit optdfa;
                 { get life info from else branch or the succesor }
                 { get life info from else branch or the succesor }
                 if assigned(tcasenode(node).elseblock) then
                 if assigned(tcasenode(node).elseblock) then
                   DFASetIncludeSet(l,tcasenode(node).elseblock.optinfo^.life)
                   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 }
                 { add use info from the "case" expression }
                 DFASetIncludeSet(l,tcasenode(node).optinfo^.use);
                 DFASetIncludeSet(l,tcasenode(node).optinfo^.use);
@@ -559,46 +536,21 @@ unit optdfa;
                 calclife(node);
                 calclife(node);
               end;
               end;
             else
             else
-              if node<>resultnode then
-                begin
-                  writeln(nodetype2str[node.nodetype]);
-                  internalerror(2007050502);
-                end;
+              internalerror(2007050502);
           end;
           end;
-
-          // exclude(node.flags,nf_processing);
         end;
         end;
 
 
       var
       var
         runs : integer;
         runs : integer;
-        dfarec : tdfainfo;
       begin
       begin
         runs:=0;
         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:[email protected]^.use;
-            dfarec.def:[email protected]^.def;
-            dfarec.map:=map;
-            AddDefUse(resultnode,@dfarec);
-            resultnode.optinfo^.life:=resultnode.optinfo^.use;
-          end
-        else
-          begin
-            resultnode:=cnothingnode.create;
-            resultnode.allocoptinfo;
-          end;
-
         repeat
         repeat
           inc(runs);
           inc(runs);
           changed:=false;
           changed:=false;
           CreateInfo(node);
           CreateInfo(node);
           foreachnodestatic(pm_postprocess,node,@ResetProcessing,nil);
           foreachnodestatic(pm_postprocess,node,@ResetProcessing,nil);
+          { the result node is not reached by foreachnodestatic }
+          exclude(resultnode.flags,nf_processing);
 {$ifdef DEBUG_DFA}
 {$ifdef DEBUG_DFA}
           PrintIndexedNodeSet(output,map);
           PrintIndexedNodeSet(output,map);
           PrintDFAInfo(output,node);
           PrintDFAInfo(output,node);
@@ -619,11 +571,35 @@ unit optdfa;
 
 
 
 
     procedure TDFABuilder.createdfainfo(node : tnode);
     procedure TDFABuilder.createdfainfo(node : tnode);
+      var
+        dfarec : tdfainfo;
       begin
       begin
         if not(assigned(nodemap)) then
         if not(assigned(nodemap)) then
           nodemap:=TIndexedNodeSet.Create;
           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:[email protected]^.use;
+            dfarec.def:[email protected]^.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 }
         { add controll flow information }
         SetNodeSucessors(node,resultnode);
         SetNodeSucessors(node,resultnode);
+
         { now, collect life information }
         { now, collect life information }
         CreateLifeInfo(node,nodemap);
         CreateLifeInfo(node,nodemap);
       end;
       end;
@@ -636,4 +612,318 @@ unit optdfa;
         inherited destroy;
         inherited destroy;
       end;
       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.
 end.

+ 17 - 2
compiler/optutils.pas

@@ -55,7 +55,7 @@ unit optutils;
     uses
     uses
       verbose,
       verbose,
       optbase,
       optbase,
-      ncal,nbas,nflw,nutils,nset;
+      ncal,nbas,nflw,nutils,nset,ncon;
 
 
     function TIndexedNodeSet.Add(node : tnode) : boolean;
     function TIndexedNodeSet.Add(node : tnode) : boolean;
       var
       var
@@ -129,6 +129,10 @@ unit optutils;
             PrintDFASet(text(arg^),n.optinfo^.def);
             PrintDFASet(text(arg^),n.optinfo^.def);
             write(text(arg^),' Use: ');
             write(text(arg^),' Use: ');
             PrintDFASet(text(arg^),n.optinfo^.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^));
             writeln(text(arg^));
           end;
           end;
         result:=fen_false;
         result:=fen_false;
@@ -222,7 +226,18 @@ unit optutils;
                 result:=p;
                 result:=p;
                 { the successor of the last node of the while/repeat body is the while node itself }
                 { the successor of the last node of the while/repeat body is the while node itself }
                 DoSet(twhilerepeatnode(p).right,p);
                 DoSet(twhilerepeatnode(p).right,p);
+
                 p.successor:=succ;
                 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);
                 Breakstack.Delete(Breakstack.Count-1);
                 Continuestack.Delete(Continuestack.Count-1);
                 Continuestack.Delete(Continuestack.Count-1);
               end;
               end;
@@ -306,7 +321,7 @@ unit optutils;
       begin
       begin
         Breakstack:=TFPList.Create;
         Breakstack:=TFPList.Create;
         Continuestack:=TFPList.Create;
         Continuestack:=TFPList.Create;
-        DoSet(p,nil);
+        DoSet(p,last);
         Continuestack.Free;
         Continuestack.Free;
         Breakstack.Free;
         Breakstack.Free;
       end;
       end;

+ 14 - 45
compiler/psub.pas

@@ -1160,7 +1160,7 @@ implementation
         n:=nil;
         n:=nil;
         foreachnodestatic(code,@searchusercode,@n);
         foreachnodestatic(code,@searchusercode,@n);
         if not(assigned(n)) then
         if not(assigned(n)) then
-          internalerror(2013111001);
+          internalerror(2013111004);
         result:=n;
         result:=n;
       end;
       end;
 
 
@@ -1293,51 +1293,19 @@ implementation
           begin
           begin
             dfabuilder:=TDFABuilder.Create;
             dfabuilder:=TDFABuilder.Create;
             dfabuilder.createdfainfo(code);
             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);
             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;
           end;
 
 
         if (pi_dfaavailable in flags) and (cs_opt_dead_store_eliminate in current_settings.optimizerswitches) then
         if (pi_dfaavailable in flags) and (cs_opt_dead_store_eliminate in current_settings.optimizerswitches) then
@@ -1898,6 +1866,7 @@ implementation
         isnestedproc     : boolean;
         isnestedproc     : boolean;
       begin
       begin
         Message1(parser_d_procedure_start,pd.fullprocname(false));
         Message1(parser_d_procedure_start,pd.fullprocname(false));
+        oldfailtokenmode:=[];
 
 
         { create a new procedure }
         { create a new procedure }
         current_procinfo:=cprocinfo.create(old_current_procinfo);
         current_procinfo:=cprocinfo.create(old_current_procinfo);

+ 16 - 0
tests/test/opt/tdfa10.pp

@@ -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 - 0
tests/test/opt/tdfa11.pp

@@ -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 - 0
tests/test/opt/tdfa12.pp

@@ -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 - 0
tests/test/opt/tdfa13.pp

@@ -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 - 0
tests/test/opt/tdfa14.pp

@@ -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 - 0
tests/test/opt/tdfa15.pp

@@ -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 - 0
tests/test/opt/tdfa16.pp

@@ -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 - 0
tests/test/opt/tdfa17.pp

@@ -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 - 0
tests/test/opt/tdfa4.pp

@@ -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 - 0
tests/test/opt/tdfa5.pp

@@ -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 - 0
tests/test/opt/tdfa6.pp

@@ -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 - 0
tests/test/opt/tdfa7.pp

@@ -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 - 0
tests/test/opt/tdfa8.pp

@@ -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 - 0
tests/test/opt/tdfa9.pp

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