Browse Source

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

git-svn-id: trunk@38578 -
Mattias Gaertner 7 years ago
parent
commit
cd4c277ae2

+ 30 - 0
packages/fcl-passrc/src/pasuseanalyzer.pas

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

+ 34 - 0
packages/fcl-passrc/tests/tcuseanalyzer.pas

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