mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-30 15:20:35 +02:00
fcl-passrc: useanalyzer: use TObject.AfterConstruction, BeforeDestruction
git-svn-id: trunk@38578 -
This commit is contained in:
parent
97e74fe6fd
commit
cd4c277ae2
@ -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;
|
||||
|
@ -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);
|
||||
|
Loading…
Reference in New Issue
Block a user