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

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

Browse Source 
git-svn-id: trunk@19692 -
This commit is contained in:
sergei 2011-11-26 05:01:30 +00:00
parent b584c71e42
commit c8e65c501a
5 changed files with 50 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -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

33
compiler/pmodules.pas
View File

@ -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;

27
compiler/psub.pas
View File

@ -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);
{ 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
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
else

11
tests/webtbs/tw19701.pas Normal file
View File

@ -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
tests/webtbs/uw19701.pas Normal file
View File

@ -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.