* Don't optimize away implicit initialization/finalization procedures if corresponding clause is present in the source but is empty. Resolves #19701.

git-svn-id: trunk@19692 -

.gitattributes

@@ -11860,6 +11860,7 @@ tests/webtbs/tw19555.pp svneol=native#text/pascal
 tests/webtbs/tw1964.pp svneol=native#text/plain
 tests/webtbs/tw19651.pp svneol=native#text/plain
 tests/webtbs/tw19700.pp svneol=native#text/plain
+tests/webtbs/tw19701.pas svneol=native#text/plain
 tests/webtbs/tw19851a.pp svneol=native#text/pascal
 tests/webtbs/tw19851b.pp svneol=native#text/pascal
 tests/webtbs/tw19864.pp svneol=native#text/pascal
@@ -12716,6 +12717,7 @@ tests/webtbs/uw18087b.pp svneol=native#text/pascal
 tests/webtbs/uw18909a.pp svneol=native#text/pascal
 tests/webtbs/uw18909b.pp svneol=native#text/pascal
 tests/webtbs/uw19159.pp svneol=native#text/pascal
+tests/webtbs/uw19701.pas svneol=native#text/plain
 tests/webtbs/uw19851.pp svneol=native#text/pascal
 tests/webtbs/uw2004.inc svneol=native#text/plain
 tests/webtbs/uw2040.pp svneol=native#text/plain

compiler/pmodules.pas

@@ -40,7 +40,7 @@ implementation
        wpoinfo,
        aasmtai,aasmdata,aasmcpu,aasmbase,
        cgbase,cgobj,
-       nbas,ncgutil,
+       nbas,nutils,ncgutil,
        link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
        cresstr,procinfo,
        pexports,
@@ -987,8 +987,6 @@ implementation
 
     function gen_implicit_initfinal(flag:word;st:TSymtable):tcgprocinfo;
       begin
-        { update module flags }
-        current_module.flags:=current_module.flags or flag;
         { create procdef }
         case flag of
           uf_init :
@@ -1311,7 +1309,8 @@ implementation
 
          { should we force unit initialization? }
          { this is a hack, but how can it be done better ? }
-         if force_init_final and ((current_module.flags and uf_init)=0) then
+         { Now the sole purpose of this is to change 'init' to 'init_implicit', is it needed at all? (Sergei) }
+         if force_init_final and assigned(init_procinfo) and has_no_code(init_procinfo.code) then
            begin
              { first release the not used init procinfo }
              if assigned(init_procinfo) then
@@ -1321,9 +1320,6 @@ implementation
          { finalize? }
          if not current_module.interface_only and (token=_FINALIZATION) then
            begin
-              { the uf_finalize flag is only set after we checked that it
-                wasn't empty }
-
               { Compile the finalize }
               finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
               finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
@@ -1338,13 +1334,21 @@ implementation
            a register that is also used in the finalize body (PFV) }
          if assigned(init_procinfo) then
            begin
-             init_procinfo.generate_code;
+             if force_init_final or not(has_no_code(init_procinfo.code)) then
+               begin
+                 init_procinfo.generate_code;
+                 current_module.flags:=current_module.flags or uf_init;
+               end;
              init_procinfo.resetprocdef;
              release_main_proc(init_procinfo);
            end;
          if assigned(finalize_procinfo) then
            begin
-             finalize_procinfo.generate_code;
+             if force_init_final or not(has_no_code(finalize_procinfo.code)) then
+               begin
+                 finalize_procinfo.generate_code;
+                 current_module.flags:=current_module.flags or uf_finalize;
+               end;
              finalize_procinfo.resetprocdef;
              release_main_proc(finalize_procinfo);
            end;
@@ -2284,9 +2288,6 @@ implementation
          { finalize? }
          if token=_FINALIZATION then
            begin
-              { the uf_finalize flag is only set after we checked that it
-                wasn't empty }
-
               { Parse the finalize }
               finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
               finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
@@ -2312,13 +2313,19 @@ implementation
          release_main_proc(main_procinfo);
          if assigned(init_procinfo) then
            begin
+             { initialization can be implicit only }
+             current_module.flags:=current_module.flags or uf_init;
              init_procinfo.generate_code;
              init_procinfo.resetprocdef;
              release_main_proc(init_procinfo);
            end;
          if assigned(finalize_procinfo) then
            begin
-             finalize_procinfo.generate_code;
+             if force_init_final or not (has_no_code(finalize_procinfo.code)) then
+               begin
+                 finalize_procinfo.generate_code;
+                 current_module.flags:=current_module.flags or uf_finalize;
+               end;
              finalize_procinfo.resetprocdef;
              release_main_proc(finalize_procinfo);
            end;

compiler/psub.pas

@@ -204,12 +204,6 @@ implementation
                         { The library init code is already called and does not
                           need to be in the initfinal table (PFV) }
                         block:=statement_block(_INITIALIZATION);
-                        { optimize empty initialization block away }
-                        if (block.nodetype=blockn) and (tblocknode(block).left=nil) then
-                          FreeAndNil(block)
-                        else
-                          if not islibrary then
-                            current_module.flags:=current_module.flags or uf_init;
                      end
                    else if token=_FINALIZATION then
                      begin
@@ -217,25 +211,12 @@ implementation
                          point when we try to read the nonh existing initalization section
                          so we've to check if we are really try to parse the finalization }
                        if current_procinfo.procdef.proctypeoption=potype_unitfinalize then
-                         begin
+                         block:=statement_block(_FINALIZATION)
-                           block:=statement_block(_FINALIZATION);
+                       else
-                           { optimize empty finalization block away }
+                         block:=nil;
-                           if (block.nodetype=blockn) and (tblocknode(block).left=nil) then
-                             FreeAndNil(block)
-                           else
-                             current_module.flags:=current_module.flags or uf_finalize;
-                         end
-                         else
-                           block:=nil;
                      end
                    else
-                     begin
+                     block:=statement_block(_BEGIN);
-                        { The library init code is already called and does not
-                          need to be in the initfinal table (PFV) }
-                        if not islibrary then
-                          current_module.flags:=current_module.flags or uf_init;
-                        block:=statement_block(_BEGIN);
-                     end;
                 end;
             end
          else

tests/webtbs/tw19701.pas

@@ -0,0 +1,11 @@
+{ %opt=-gh }
+
+program tw19701;
+{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
+{$ifdef mswindows}{$apptype console}{$endif}
+uses
+ {$ifdef FPC}{$ifdef linux}cthreads,cwstring,{$endif}{$endif}
+ sysutils,uw19701;
+begin
+  HaltOnNotReleased:=True;
+end.

tests/webtbs/uw19701.pas

@@ -0,0 +1,13 @@
+unit uw19701;
+{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
+interface
+var
+ testvar: array of integer;
+implementation
+
+// an empty finalization section should not prevent
+// generating the implicit finalization code
+initialization
+ setlength(testvar,100);
+finalization
+end.