mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 05:00:12 +02:00
fcl-passrc: useanalyzer: mark parents of nested elements
git-svn-id: trunk@41297 -
This commit is contained in:
parent
a12ca1c1a0
commit
739723bc54
@ -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;
|
||||
|
@ -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);
|
||||
|
||||
|
@ -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);
|
||||
|
Loading…
Reference in New Issue
Block a user