fcl-passrc: fixed WPO for attributes with parameters

git-svn-id: trunk@41503 -
This commit is contained in:
Mattias Gaertner 2019-02-27 08:40:14 +00:00
parent 06074197ab
commit 20c854ad90
2 changed files with 36 additions and 1 deletions

View File

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

View File

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