fcl-passrc: useanalyzer: mark parents of nested elements

git-svn-id: trunk@41297 -
This commit is contained in:
Mattias Gaertner 2019-02-11 12:15:22 +00:00
parent a12ca1c1a0
commit 739723bc54
3 changed files with 55 additions and 25 deletions

View File

@ -8861,6 +8861,12 @@ end;
procedure TPasResolver.ResolveSubIdent(El: TBinaryExpr;
Access: TResolvedRefAccess);
procedure ResolveRight; inline;
begin
ResolveExpr(El.right,Access);
PopScope;
end;
function SearchInTypeHelpers(aType: TPasType; IdentEl: TPasElement): boolean;
var
DotScope: TPasDotBaseScope;
@ -8871,8 +8877,7 @@ procedure TPasResolver.ResolveSubIdent(El: TBinaryExpr;
if IdentEl is TPasType then
// e.g. TFlag.HelperProc
DotScope.OnlyTypeMembers:=true;
ResolveExpr(El.right,Access);
PopScope;
ResolveRight;
Result:=true;
end;
@ -8901,8 +8906,7 @@ begin
// => search in interface and if this is our module in the implementation
aModule:=NoNil(LeftResolved.IdentEl) as TPasModule;
PushModuleDotScope(aModule);
ResolveExpr(El.right,Access);
PopScope;
ResolveRight;
exit;
end
else if LeftResolved.LoTypeEl=nil then
@ -8934,8 +8938,7 @@ begin
else
// e.g. Image.Width
ClassScope.OnlyTypeMembers:=false;
ResolveExpr(El.right,Access);
PopScope;
ResolveRight;
exit;
end
else if LTypeEl.ClassType=TPasClassOfType then
@ -8945,8 +8948,7 @@ begin
ClassScope:=PushClassDotScope(ClassEl);
ClassScope.OnlyTypeMembers:=true;
ClassScope.IsClassOf:=true;
ResolveExpr(El.right,Access);
PopScope;
ResolveRight;
exit;
end
else if LTypeEl.ClassType=TPasRecordType then
@ -8963,8 +8965,7 @@ begin
AccessExpr(El.left,Access);
RecordScope.OnlyTypeMembers:=false;
end;
ResolveExpr(El.right,Access);
PopScope;
ResolveRight;
exit;
end
else if LTypeEl.ClassType=TPasEnumType then
@ -8974,8 +8975,7 @@ begin
// e.g. TShiftState.ssAlt
DotScope:=PushEnumDotScope(TPasEnumType(LTypeEl));
DotScope.OnlyTypeMembers:=true;
ResolveExpr(El.right,Access);
PopScope;
ResolveRight;
exit;
end;
end;

View File

@ -260,7 +260,7 @@ type
procedure UseInheritedExpr(El: TInheritedExpr); virtual;
procedure UseScopeReferences(Refs: TPasScopeReferences); virtual;
procedure UseProcedure(Proc: TPasProcedure); virtual;
procedure UseProcedureType(ProcType: TPasProcedureType; Mark: boolean); virtual;
procedure UseProcedureType(ProcType: TPasProcedureType); virtual;
procedure UseType(El: TPasType; Mode: TPAUseMode); virtual;
procedure UseClassOrRecType(El: TPasMembersType; Mode: TPAUseMode); virtual;
procedure UseVariable(El: TPasVariable; Access: TResolvedRefAccess;
@ -1010,19 +1010,18 @@ begin
else if C.InheritsFrom(TPasExpr) then
UseExpr(TPasExpr(El))
else if C=TPasEnumValue then
begin
UseExpr(TPasEnumValue(El).Value);
repeat
MarkElementAsUsed(El);
El:=El.Parent;
until not (El is TPasType);
end
UseExpr(TPasEnumValue(El).Value)
else if C=TPasMethodResolution then
// nothing to do
else if (C.InheritsFrom(TPasModule)) or (C=TPasUsesUnit) then
// e.g. unitname.identifier -> the module is used by the identifier
else
RaiseNotSupported(20170307090947,El);
repeat
El:=El.Parent;
if not (El is TPasType) then break;
MarkElementAsUsed(El);
until false;
end;
procedure TPasAnalyzer.UseTypeInfo(El: TPasElement);
@ -1729,7 +1728,7 @@ begin
{$ENDIF}
UseScopeReferences(ProcScope.References);
UseProcedureType(Proc.ProcType,false);
UseProcedureType(Proc.ProcType);
ImplProc:=Proc;
if ProcScope.ImplProc<>nil then
@ -1778,8 +1777,7 @@ begin
end;
end;
procedure TPasAnalyzer.UseProcedureType(ProcType: TPasProcedureType;
Mark: boolean);
procedure TPasAnalyzer.UseProcedureType(ProcType: TPasProcedureType);
var
i: Integer;
Arg: TPasArgument;
@ -1787,7 +1785,7 @@ begin
{$IFDEF VerbosePasAnalyzer}
writeln('TPasAnalyzer.UseProcedureType ',GetElModName(ProcType));
{$ENDIF}
if Mark and not MarkElementAsUsed(ProcType) then exit;
if not MarkElementAsUsed(ProcType) then exit;
for i:=0 to ProcType.Args.Count-1 do
begin
@ -1869,7 +1867,7 @@ begin
UseElType(El,TPasSetType(El).EnumType,Mode);
end
else if C.InheritsFrom(TPasProcedureType) then
UseProcedureType(TPasProcedureType(El),true)
UseProcedureType(TPasProcedureType(El))
else
RaiseNotSupported(20170306170315,El);

View File

@ -164,6 +164,7 @@ type
procedure TestWP_ClassInterface_COM_Unit;
procedure TestWP_ClassInterface_Typeinfo;
procedure TestWP_ClassInterface_TGUID;
procedure TestWP_ClassHelper;
// scope references
procedure TestSR_Proc_UnitVar;
@ -3061,6 +3062,37 @@ begin
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ClassHelper;
begin
StartProgram(false);
Add([
'type',
' {#TObject_used}TObject = class',
' end;',
' {#TBird_used}TBird = class',
' {#TBird_A_notused}A: word;',
' end;',
' {#TAnt_used}TAnt = class',
' {#TAnt_B_notused}B: word;',
' type',
' {#TMouth_used}TMouth = class',
' {#TMouth_C_notused}C: word;',
' type',
' {#TBirdHelper_used}TBirdHelper = class helper for TBird',
' procedure {#TBirdHelper_Fly_used}Fly;',
' end;',
' end;',
' end;',
'procedure TAnt.TMouth.TBirdHelper.Fly;',
'begin',
'end;',
'var b: TBird;',
'begin',
' b.Fly;;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestSR_Proc_UnitVar;
begin
StartUnit(false);