Selaa lähdekoodia

* 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 -
sergei 13 vuotta sitten
vanhempi
commit
c8e65c501a
5 muutettua tiedostoa jossa 50 lisäystä ja 36 poistoa
  1. 2 0
      .gitattributes
  2. 20 13
      compiler/pmodules.pas
  3. 4 23
      compiler/psub.pas
  4. 11 0
      tests/webtbs/tw19701.pas
  5. 13 0
      tests/webtbs/uw19701.pas

+ 2 - 0
.gitattributes

@@ -11860,6 +11860,7 @@ tests/webtbs/tw19555.pp svneol=native#text/pascal
 tests/webtbs/tw1964.pp svneol=native#text/plain
 tests/webtbs/tw1964.pp svneol=native#text/plain
 tests/webtbs/tw19651.pp svneol=native#text/plain
 tests/webtbs/tw19651.pp svneol=native#text/plain
 tests/webtbs/tw19700.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/tw19851a.pp svneol=native#text/pascal
 tests/webtbs/tw19851b.pp svneol=native#text/pascal
 tests/webtbs/tw19851b.pp svneol=native#text/pascal
 tests/webtbs/tw19864.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/uw18909a.pp svneol=native#text/pascal
 tests/webtbs/uw18909b.pp svneol=native#text/pascal
 tests/webtbs/uw18909b.pp svneol=native#text/pascal
 tests/webtbs/uw19159.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/uw19851.pp svneol=native#text/pascal
 tests/webtbs/uw2004.inc svneol=native#text/plain
 tests/webtbs/uw2004.inc svneol=native#text/plain
 tests/webtbs/uw2040.pp svneol=native#text/plain
 tests/webtbs/uw2040.pp svneol=native#text/plain

+ 20 - 13
compiler/pmodules.pas

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

+ 4 - 23
compiler/psub.pas

@@ -204,12 +204,6 @@ implementation
                         { The library init code is already called and does not
                         { The library init code is already called and does not
                           need to be in the initfinal table (PFV) }
                           need to be in the initfinal table (PFV) }
                         block:=statement_block(_INITIALIZATION);
                         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
                      end
                    else if token=_FINALIZATION then
                    else if token=_FINALIZATION then
                      begin
                      begin
@@ -217,25 +211,12 @@ implementation
                          point when we try to read the nonh existing initalization section
                          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 }
                          so we've to check if we are really try to parse the finalization }
                        if current_procinfo.procdef.proctypeoption=potype_unitfinalize then
                        if current_procinfo.procdef.proctypeoption=potype_unitfinalize then
-                         begin
-                           block:=statement_block(_FINALIZATION);
-                           { optimize empty finalization block away }
-                           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;
+                         block:=statement_block(_FINALIZATION)
+                       else
+                         block:=nil;
                      end
                      end
                    else
                    else
-                     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;
+                     block:=statement_block(_BEGIN);
                 end;
                 end;
             end
             end
          else
          else

+ 11 - 0
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.

+ 13 - 0
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.