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

* no longer create implicit fail-cleanup code for TP-style object

Browse Source 
constructors without an implicit exception frame (bug introduced
    in r15583, fixes cycle on linux/i386)

git-svn-id: trunk@15594 -
This commit is contained in:
Jonas Maebe 2010-07-17 19:45:03 +00:00
parent eead32ac62
commit c30279cdc8
1 changed files with 43 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
compiler/psub.pas
View File

@ -33,7 +33,7 @@ interface
type type
tcgprocinfo = class(tprocinfo) tcgprocinfo = class(tprocinfo)
private private
procedure maybe_add_constructor_wrapper(var tocode: tnode); procedure maybe_add_constructor_wrapper(var tocode: tnode; withexceptblock: boolean);
procedure add_entry_exit_code; procedure add_entry_exit_code;
public public
{ code for the subroutine as tree } { code for the subroutine as tree }
@ -570,7 +570,7 @@ implementation
end; end;
procedure tcgprocinfo.maybe_add_constructor_wrapper(var tocode: tnode); procedure tcgprocinfo.maybe_add_constructor_wrapper(var tocode: tnode; withexceptblock: boolean);
var var
oldlocalswitches: tlocalswitches; oldlocalswitches: tlocalswitches;
srsym: tsym; srsym: tsym;
@ -583,7 +583,11 @@ implementation
if assigned(current_objectdef) and if assigned(current_objectdef) and
(current_procinfo.procdef.proctypeoption=potype_constructor) then (current_procinfo.procdef.proctypeoption=potype_constructor) then
begin begin
exceptblock:=nil; { Don't test self and the vmt here. See generate_bodyexit_block }
{ why (JM) }
oldlocalswitches:=current_settings.localswitches;
current_settings.localswitches:=oldlocalswitches-[cs_check_object,cs_check_range];
{ call AfterConstruction for classes } { call AfterConstruction for classes }
if is_class(current_objectdef) then if is_class(current_objectdef) then
begin begin
@ -595,7 +599,7 @@ implementation
afterconstructionblock:=internalstatements(newstatement); afterconstructionblock:=internalstatements(newstatement);
{ first execute all constructor code. If no exception { first execute all constructor code. If no exception
occurred then we will execute afterconstruction, occurred then we will execute afterconstruction,
otherwise we won't be (the exception will jump over us) } otherwise we won't (the exception will jump over us) }
addstatement(newstatement,tocode); addstatement(newstatement,tocode);
{ Self can be nil when fail is called } { Self can be nil when fail is called }
{ if self<>nil and vmt<>nil then afterconstruction } { if self<>nil and vmt<>nil then afterconstruction }
@ -615,36 +619,42 @@ implementation
internalerror(200305106); internalerror(200305106);
end; end;
{ Generate the "fail" code for a constructor (destroy in case an if withexceptblock then
exception happened) }
{ Don't test self and the vmt here. See generate_bodyexit_block }
{ why (JM) }
oldlocalswitches:=current_settings.localswitches;
current_settings.localswitches:=oldlocalswitches-[cs_check_object,cs_check_range];
pd:=current_objectdef.find_destructor;
{ this will always be the case for classes, since tobject has
a destructor }
if assigned(pd) then
begin begin
current_filepos:=exitpos; { Generate the implicit "fail" code for a constructor (destroy
exceptblock:=internalstatements(newstatement); in case an exception happened) }
{ if vmt<>0 then call destructor } pd:=current_objectdef.find_destructor;
addstatement(newstatement,cifnode.create( { this will always be the case for classes, since tobject has
caddnode.create(unequaln, a destructor }
if assigned(pd) then
begin
current_filepos:=exitpos;
exceptblock:=internalstatements(newstatement);
{ first free the instance if non-nil }
{ if vmt<>0 then call destructor }
addstatement(newstatement,cifnode.create(
caddnode.create(unequaln,
load_vmt_pointer_node, load_vmt_pointer_node,
cnilnode.create), cnilnode.create),
{ cnf_create_failed -> don't call BeforeDestruction } { cnf_create_failed -> don't call BeforeDestruction }
ccallnode.create(nil,tprocsym(pd.procsym),pd.procsym.owner,load_self_node,[cnf_create_failed]), ccallnode.create(nil,tprocsym(pd.procsym),pd.procsym.owner,load_self_node,[cnf_create_failed]),
nil)); nil));
{ re-raise the exception } { then re-raise the exception }
addstatement(newstatement,craisenode.create(nil,nil,nil)); addstatement(newstatement,craisenode.create(nil,nil,nil));
current_filepos:=entrypos; current_filepos:=entrypos;
newblock:=internalstatements(newstatement); newblock:=internalstatements(newstatement);
addstatement(newstatement,ctryexceptnode.create( { try
tocode, tocode
nil, except
exceptblock)); exceptblock
tocode:=newblock; end
}
addstatement(newstatement,ctryexceptnode.create(
tocode,
nil,
exceptblock));
tocode:=newblock;
end;
end; end;
current_settings.localswitches:=oldlocalswitches; current_settings.localswitches:=oldlocalswitches;
end; end;
@ -709,7 +719,7 @@ implementation
refcounted class (afterconstruction decreases the refcount refcounted class (afterconstruction decreases the refcount
without freeing the instance if the count becomes nil, while without freeing the instance if the count becomes nil, while
the finalising of the temps can free the instance) } the finalising of the temps can free the instance) }
maybe_add_constructor_wrapper(wrappedbody); maybe_add_constructor_wrapper(wrappedbody,true);
addstatement(newstatement,wrappedbody); addstatement(newstatement,wrappedbody);
addstatement(newstatement,exitlabel_asmnode); addstatement(newstatement,exitlabel_asmnode);
addstatement(newstatement,bodyexitcode); addstatement(newstatement,bodyexitcode);
@ -718,7 +728,7 @@ implementation
end end
else else
begin begin
maybe_add_constructor_wrapper(code); maybe_add_constructor_wrapper(code,false);
addstatement(newstatement,loadpara_asmnode); addstatement(newstatement,loadpara_asmnode);
addstatement(newstatement,stackcheck_asmnode); addstatement(newstatement,stackcheck_asmnode);
addstatement(newstatement,entry_asmnode); addstatement(newstatement,entry_asmnode);