fcl-passrc: useanalyzer: use TObject.AfterConstruction, BeforeDestruction

git-svn-id: trunk@38578 -
This commit is contained in:
Mattias Gaertner 2018-03-20 17:02:17 +00:00
parent 97e74fe6fd
commit cd4c277ae2
2 changed files with 64 additions and 0 deletions

View File

@ -1372,6 +1372,10 @@ procedure TPasAnalyzer.UseProcedure(Proc: TPasProcedure);
var
ProcScope: TPasProcedureScope;
ImplProc: TPasProcedure;
ClassScope: TPasClassScope;
Name: String;
Identifier: TPasIdentifier;
El: TPasElement;
begin
if Proc=nil then exit;
// use declaration, not implementation
@ -1399,6 +1403,32 @@ begin
// mark overrides
if [pmOverride,pmVirtual]*Proc.Modifiers<>[] then
UseOverrides(Proc);
if ((Proc.ClassType=TPasConstructor) or (Proc.ClassType=TPasDestructor))
and (Proc.Parent is TPasClassType) then
begin
ClassScope:=Proc.Parent.CustomData as TPasClassScope;
if ClassScope.AncestorScope=nil then
begin
// root class constructor -> mark AfterConstruction
if Proc.ClassType=TPasConstructor then
Name:='AfterConstruction'
else
Name:='BeforeDestruction';
Identifier:=ClassScope.FindLocalIdentifier(Name);
while Identifier<>nil do
begin
El:=Identifier.Element;
if (El.ClassType=TPasProcedure)
and (TPasProcedure(El).ProcType.Args.Count=0) then
begin
UseProcedure(TPasProcedure(El));
break;
end;
Identifier:=Identifier.NextSameIdentifier;
end;
end;
end;
end;
procedure TPasAnalyzer.UseProcedureType(ProcType: TPasProcedureType;

View File

@ -130,6 +130,7 @@ type
procedure TestWP_ProgramPublicDeclarations;
procedure TestWP_ClassOverride;
procedure TestWP_ClassDefaultProperty;
procedure TestWP_BeforeConstruction;
procedure TestWP_Published;
procedure TestWP_PublishedSetType;
procedure TestWP_PublishedArrayType;
@ -2047,6 +2048,39 @@ begin
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_BeforeConstruction;
begin
StartProgram(false);
Add([
'type',
' {#tobject_used}TObject = class',
' procedure {#oAfter_used}AfterConstruction; virtual;',
' procedure {#oBefore_used}BeforeDestruction; virtual;',
' procedure {#oFree_used}Free;',
' constructor {#oCreate_used}Create;',
' destructor {#oDestroy_used}Destroy; virtual;',
' procedure {#oDoIt_notused}DoIt; virtual; abstract;',
' end;',
' TBird = class',
' procedure {#bAfter_used}AfterConstruction; override;',
' procedure {#bBefore_used}BeforeDestruction; override;',
' end;',
'procedure TObject.AfterConstruction; begin end;',
'procedure TObject.BeforeDestruction; begin end;',
'procedure TObject.Free; begin Destroy; end;',
'constructor TObject.Create; begin end;',
'destructor TObject.Destroy; begin end;',
'procedure TBird.AfterConstruction; begin end;',
'procedure TBird.BeforeDestruction; begin end;',
'var',
' {#b_used}b: TBird;',
'begin',
' b:=TBird.Create;',
' b.Free;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_Published;
begin
StartProgram(false);