Quellcode durchsuchen

fcl-passrc: fixed WPO for attributes with parameters

git-svn-id: trunk@41503 -
Mattias Gaertner vor 6 Jahren
Ursprung
Commit
20c854ad90

+ 4 - 1
packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1778,6 +1778,9 @@ begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UseProcedure ',GetElModName(Proc));
   {$ENDIF}
+  if Proc.Parent is TPasMembersType then
+    UseClassOrRecType(TPasMembersType(Proc.Parent),paumElement);
+
   UseScopeReferences(ProcScope.References);
 
   UseProcedureType(Proc.ProcType);
@@ -2011,7 +2014,7 @@ begin
     RaiseInconsistency(20170414152143,IntToStr(ord(Mode)));
   end;
   {$IFDEF VerbosePasAnalyzer}
-  writeln('TPasAnalyzer.UseClassType ',GetElModName(El),' ',Mode,' First=',FirstTime);
+  writeln('TPasAnalyzer.UseClassOrRecType ',GetElModName(El),' ',Mode,' First=',FirstTime);
   {$ENDIF}
   aClass:=nil;
   ClassScope:=nil;

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

@@ -168,6 +168,7 @@ type
     procedure TestWP_ClassHelper_ClassConstrucor_Used;
     procedure TestWP_Attributes;
     procedure TestWP_Attributes_ForwardClass;
+    procedure TestWP_Attributes_Params;
 
     // scope references
     procedure TestSR_Proc_UnitVar;
@@ -3204,6 +3205,37 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_Attributes_Params;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '    constructor {#TObject_Create_notused}Create;',
+  '    destructor {#TObject_Destroy_used}Destroy; virtual;',
+  '  end;',
+  '  {#TCustomAttribute_used}TCustomAttribute = class',
+  '  end;',
+  '  {#BigAttribute_used}BigAttribute = class(TCustomAttribute)',
+  '    constructor {#Big_A_used}Create(Id: word = 3); overload;',
+  '    destructor {#Big_B_used}Destroy; override;',
+  '  end;',
+  'constructor TObject.Create; begin end;',
+  'destructor TObject.Destroy; begin end;',
+  'constructor BigAttribute.Create(Id: word); begin end;',
+  'destructor BigAttribute.Destroy; begin end;',
+  'var',
+  '  [Big(3)]',
+  '  o: TObject;',
+  '  a: TCustomAttribute;',
+  'begin',
+  '  if typeinfo(o)=nil then ;',
+  '  a.Destroy;',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
 procedure TTestUseAnalyzer.TestSR_Proc_UnitVar;
 begin
   StartUnit(false);