fcl-passrc: useanalyzer: collect single procedure references

git-svn-id: trunk@38305 -

packages/fcl-passrc/src/pasresolver.pp

@@ -690,7 +690,6 @@ type
     Owner: TObject;
     {$ENDIF}
     Access: TPSRefAccess;
-    NeedTypeInfo: boolean;
     NextSameName: TPasProcScopeReference;
     destructor Destroy; override;
     property Element: TPasElement read FElement write SetElement;
@@ -706,6 +705,7 @@ type
   TPasProcedureScope = Class(TPasIdentifierScope)
   private
     procedure OnClearReferenceItem(Item, Dummy: pointer);
+    procedure OnCollectReferenceItem(Item, aList: pointer);
   public
     DeclarationProc: TPasProcedure; // the corresponding forward declaration
     ImplProc: TPasProcedure; // the corresponding proc with Body
@@ -726,6 +726,7 @@ type
     procedure ClearReferences;
     function AddReference(El: TPasElement; Access: TPSRefAccess): TPasProcScopeReference;
     function FindReference(const aName: string): TPasProcScopeReference;
+    function GetReferences: TFPList;
   end;
   TPasProcedureScopeClass = class of TPasProcedureScope;
 
@@ -2274,6 +2275,14 @@ begin
     end;
 end;
 
+procedure TPasProcedureScope.OnCollectReferenceItem(Item, aList: pointer);
+var
+  Ref: TPasProcScopeReference absolute Item;
+  List: TFPList absolute aList;
+begin
+  List.Add(Ref);
+end;
+
 function TPasProcedureScope.FindIdentifier(const Identifier: String
   ): TPasIdentifier;
 begin
@@ -2434,6 +2443,13 @@ begin
   Result:=TPasProcScopeReference(References.Find(LoName));
 end;
 
+function TPasProcedureScope.GetReferences: TFPList;
+begin
+  Result:=TFPList.Create;
+  if References=nil then exit;
+  References.ForEachCall(@OnCollectReferenceItem,Result);
+end;
+
 { TPasClassScope }
 
 destructor TPasClassScope.Destroy;
@@ -3092,7 +3108,7 @@ end;
 function TPasIdentifierScope.GetLocalIdentifiers: TFPList;
 begin
   Result:=TFPList.Create;
-  FItems.ForEachCall(@OnCollectItem,Pointer(Result));
+  FItems.ForEachCall(@OnCollectItem,Result);
 end;
 
 { TPasResolver }

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -160,6 +160,15 @@ type
     paumPublished // Mark element and its type and descend into children and mark published identifiers
     );
   TPAUseModes = set of TPAUseMode;
+const
+  PAUseModeToPSRefAccess: array[TPAUseMode] of TPSRefAccess = (
+    psraRead,
+    psraRead,
+    psraRead,
+    psraTypeInfo
+    );
+
+type
 
   { TPasAnalyzer }
 
@@ -172,6 +181,8 @@ type
     FResolver: TPasResolver;
     FScopeModule: TPasModule;
     FUsedElements: TAVLTree; // tree of TPAElement sorted for Element
+    FRefProcDecl: TPasProcedure; // if set, collect only what this proc references
+    FRefProcScope: TPasProcedureScope; // the ProcScope of FRefProcDecl
     function AddOverride(OverriddenEl, OverrideEl: TPasElement): boolean;
     function FindOverrideNode(El: TPasElement): TAVLTreeNode;
     function FindOverrideList(El: TPasElement): TPAOverrideList;
@@ -188,6 +199,7 @@ type
     procedure CreateTree; virtual;
     function MarkElementAsUsed(El: TPasElement; aClass: TPAElementClass = nil): boolean; // true if new
     function ElementVisited(El: TPasElement; Mode: TPAUseMode): boolean;
+    function MarkProcRef(El: TPasElement; Access: TPSRefAccess): boolean; // true if outside FRefProcDecl
     procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UsePublished(El: TPasElement); virtual;
@@ -222,6 +234,7 @@ type
     procedure Clear;
     procedure AnalyzeModule(aModule: TPasModule);
     procedure AnalyzeWholeProgram(aStartModule: TPasProgram);
+    procedure AnalyzeProcRefs(Proc: TPasProcedure);
     procedure EmitModuleHints(aModule: TPasModule); virtual;
     function FindElement(El: TPasElement): TPAElement;
     // utility
@@ -488,6 +501,9 @@ end;
 
 procedure TPasAnalyzer.RaiseInconsistency(const Id: int64; Msg: string);
 begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.RaiseInconsistency ['+IntToStr(Id)+']: '+Msg);
+  {$ENDIF}
   raise EPasAnalyzer.Create('['+IntToStr(Id)+']: '+Msg);
 end;
 
@@ -594,6 +610,22 @@ begin
   FChecked[Mode].Add(El);
 end;
 
+function TPasAnalyzer.MarkProcRef(El: TPasElement; Access: TPSRefAccess
+  ): boolean;
+var
+  Parent: TPasElement;
+begin
+  Parent:=El;
+  while Parent<>nil do
+    begin
+    if (Parent=FRefProcDecl) or (Parent=FRefProcScope.ImplProc) then
+      exit(false); // inside proc
+    Parent:=Parent.Parent;
+    end;
+  FRefProcScope.AddReference(El,Access);
+  Result:=true;
+end;
+
 procedure TPasAnalyzer.UseElement(El: TPasElement; Access: TResolvedRefAccess;
   UseFull: boolean);
 var
@@ -644,6 +676,8 @@ begin
   writeln('TPasAnalyzer.UsePublished START ',GetObjName(El));
   {$ENDIF}
   if ElementVisited(El,paumPublished) then exit;
+  if (FRefProcDecl<>nil) and MarkProcRef(El,psraTypeInfo) then exit;
+
   C:=El.ClassType;
   if C=TPasUnresolvedSymbolRef then
   else if (C=TPasVariable) or (C=TPasConst) then
@@ -728,6 +762,8 @@ var
   ModScope: TPasModuleScope;
 begin
   if ElementVisited(aModule,Mode) then exit;
+  if (FRefProcDecl<>nil) and MarkProcRef(aModule,psraRead) then exit;
+
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UseModule ',GetElModName(aModule),' Mode=',Mode);
   {$ENDIF}
@@ -1221,9 +1257,11 @@ begin
     exit; // skip implementation, Note:PasResolver always refers the declaration
 
   if not MarkElementAsUsed(Proc) then exit;
+  if (FRefProcDecl<>nil) and MarkProcRef(Proc,psraRead) then exit;
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UseProcedure ',GetElModName(Proc));
   {$ENDIF}
+
   UseProcedureType(Proc.ProcType,false);
 
   ImplProc:=Proc;
@@ -1232,12 +1270,15 @@ begin
   if ImplProc.Body<>nil then
     UseImplBlock(ImplProc.Body.Body,false);
 
-  if Proc.IsOverride and (ProcScope.OverriddenProc<>nil) then
-    AddOverride(ProcScope.OverriddenProc,Proc);
+  if FRefProcDecl=nil then
+    begin
+    if Proc.IsOverride and (ProcScope.OverriddenProc<>nil) then
+      AddOverride(ProcScope.OverriddenProc,Proc);
 
-  // mark overrides
-  if [pmOverride,pmVirtual]*Proc.Modifiers<>[] then
-    UseOverrides(Proc);
+    // mark overrides
+    if [pmOverride,pmVirtual]*Proc.Modifiers<>[] then
+      UseOverrides(Proc);
+    end;
 end;
 
 procedure TPasAnalyzer.UseProcedureType(ProcType: TPasProcedureType;
@@ -1250,10 +1291,11 @@ begin
   writeln('TPasAnalyzer.UseProcedureType ',GetElModName(ProcType));
   {$ENDIF}
   if Mark and not MarkElementAsUsed(ProcType) then exit;
+
   for i:=0 to ProcType.Args.Count-1 do
     begin
     Arg:=TPasArgument(ProcType.Args[i]);
-    // Note: arguments are marked when used in code
+    // Note: the arguments themselves are marked when used in code
     // mark argument type and default value
     UseType(Arg.ArgType,paumElement);
     UseExpr(Arg.ValueExpr);
@@ -1268,6 +1310,8 @@ var
   i: Integer;
 begin
   if El=nil then exit;
+  if (FRefProcDecl<>nil) and MarkProcRef(El,PAUseModeToPSRefAccess[Mode]) then exit;
+
   C:=El.ClassType;
   if Mode=paumAllExports then
     begin
@@ -1473,6 +1517,8 @@ begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UseVariable ',GetElModName(El),' ',Access,' Full=',UseFull);
   {$ENDIF}
+  if (FRefProcDecl<>nil) and MarkProcRef(El,ResolvedToPSRefAccess[Access]) then exit;
+
   if El.ClassType=TPasProperty then
     Prop:=TPasProperty(El)
   else
@@ -1567,8 +1613,8 @@ end;
 
 procedure TPasAnalyzer.UseResourcestring(El: TPasResString);
 begin
-  if MarkElementAsUsed(El) then
-    UseExpr(El.Expr);
+  if not MarkElementAsUsed(El) then exit;
+  UseExpr(El.Expr);
 end;
 
 procedure TPasAnalyzer.UseArgument(El: TPasArgument; Access: TResolvedRefAccess
@@ -1577,6 +1623,8 @@ var
   Usage: TPAElement;
   IsRead, IsWrite: Boolean;
 begin
+  if FRefProcDecl<>nil then exit;
+
   IsRead:=false;
   IsWrite:=false;
   case Access of
@@ -1611,6 +1659,8 @@ var
   IsRead, IsWrite: Boolean;
   Usage: TPAElement;
 begin
+  if FRefProcDecl<>nil then exit;
+
   IsRead:=false;
   IsWrite:=false;
   case Access of
@@ -1642,6 +1692,8 @@ end;
 procedure TPasAnalyzer.EmitElementHints(El: TPasElement);
 begin
   if El=nil then exit;
+  if FRefProcDecl<>nil then exit;
+
   if El is TPasVariable then
     EmitVariableHints(TPasVariable(El))
   else if El is TPasType then
@@ -1957,6 +2009,36 @@ begin
   {$ENDIF}
 end;
 
+procedure TPasAnalyzer.AnalyzeProcRefs(Proc: TPasProcedure);
+var
+  ProcScope: TPasProcedureScope;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.AnalyzeProcRefs START ',GetObjName(Proc));
+  {$ENDIF}
+  if Resolver=nil then
+    RaiseInconsistency(20180221110035,'TPasAnalyzer.AnalyzeProcRefs missing Resolver '+GetObjName(Proc));
+  if FUsedElements.Count>0 then
+    RaiseInconsistency(20180221110035,GetObjName(Proc));
+  ScopeModule:=Proc.GetModule;
+  ProcScope:=NoNil(Proc.CustomData) as TPasProcedureScope;
+  if ProcScope.References<>nil then
+    RaiseInconsistency(20180221161728,GetObjName(Proc));
+  if ProcScope.DeclarationProc<>nil then
+    RaiseInconsistency(20180221110215,GetObjName(Proc));
+  FRefProcDecl:=Proc;
+  FRefProcScope:=ProcScope;
+  try
+    UseProcedure(Proc);
+  finally
+    FRefProcDecl:=nil;
+    FRefProcScope:=nil;
+  end;
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.AnalyzeProcRefs END ',GetObjName(Proc));
+  {$ENDIF}
+end;
+
 procedure TPasAnalyzer.EmitModuleHints(aModule: TPasModule);
 begin
   {$IFDEF VerbosePasAnalyzer}
@@ -2106,6 +2188,7 @@ end;
 
 procedure TPasAnalyzer.EmitMessage(Msg: TPAMessage);
 begin
+  if FRefProcDecl<>nil then exit;
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitMessage [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') ',Msg.MsgText);
   {$ENDIF}

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -35,6 +35,8 @@ type
       const MsgText: string); virtual;
     procedure CheckUseAnalyzerUnexpectedHints; virtual;
     procedure CheckUnitUsed(const aFilename: string; Used: boolean); virtual;
+    procedure CheckUnitProcedureReferences(const ProcName: string;
+      const RefNames: array of string);
   public
     property Analyzer: TPasAnalyzer read FAnalyzer;
     function PAMessageCount: integer;
@@ -136,10 +138,20 @@ type
     procedure TestWP_ForInClass;
     procedure TestWP_AssertSysUtils;
     procedure TestWP_RangeErrorSysUtils;
+
+    // procedure references
+    procedure TestPR_UnitVar;
   end;
 
+function dbgs(a: TPSRefAccess) : string;
+
 implementation
 
+function dbgs(a: TPSRefAccess): string;
+begin
+  str(a,Result);
+end;
+
 { TCustomTestUseAnalyzer }
 
 procedure TCustomTestUseAnalyzer.OnAnalyzerMessage(Sender: TObject;
@@ -330,6 +342,132 @@ begin
     end;
 end;
 
+procedure TCustomTestUseAnalyzer.CheckUnitProcedureReferences(
+  const ProcName: string; const RefNames: array of string);
+type
+  TEntry = record
+    Name: string;
+    Access: TPSRefAccess;
+  end;
+
+var
+  Entries: array of TEntry;
+
+  procedure CheckRefs(Scope: TPasProcedureScope);
+
+    procedure DumpRefsAndFail(Refs: TFPList; const Msg: string);
+    var
+      i: Integer;
+      Ref: TPasProcScopeReference;
+    begin
+      for i:=0 to Refs.Count-1 do
+        begin
+        Ref:=TPasProcScopeReference(Refs[i]);
+        if Ref=nil then break;
+        {$IFDEF VerbosePasAnalyzer}
+        writeln('DumpRefsAndFail ',i,' ',GetObjName(Ref.Element),' ',Ref.Access);
+        {$ENDIF}
+        end;
+      Fail(Msg);
+    end;
+
+  var
+    Refs: TFPList;
+    j, i: Integer;
+    o: TObject;
+    Ref: TPasProcScopeReference;
+  begin
+    Refs:=Scope.GetReferences;
+    try
+      // check that Refs only contains TPasProcScopeReference
+      for i:=0 to Refs.Count-1 do
+        begin
+        o:=TObject(Refs[i]);
+        if not (o is TPasProcScopeReference) then
+          Fail('Refs['+IntToStr(i)+'] '+GetObjName(o));
+        end;
+      // check that all Entries are referenced
+      for i:=0 to length(Entries)-1 do
+        begin
+        j:=Refs.Count-1;
+        while (j>=0)
+            and (CompareText(Entries[i].Name,TPasProcScopeReference(Refs[j]).Element.Name)<>0) do
+          dec(j);
+        if j<0 then
+          DumpRefsAndFail(Refs,'Missing reference "'+Entries[i].Name+'"');
+        Ref:=TPasProcScopeReference(Refs[j]);
+        if (Entries[i].Access<>psraNone) and (Ref.Access<>Entries[i].Access) then
+          DumpRefsAndFail(Refs,'Wrong reference access "'+Entries[i].Name+'",'
+            +' expected '+dbgs(Entries[i].Access)+', but got '+dbgs(Ref.Access));
+        end;
+      // check that no other references are in Refs
+      for i:=0 to Refs.Count-1 do
+        begin
+        Ref:=TPasProcScopeReference(Refs[i]);
+        j:=length(Entries)-1;
+        while (j>=0)
+            and (CompareText(Ref.Element.Name,Entries[j].Name)<>0) do
+          dec(j);
+        if j<0 then
+          DumpRefsAndFail(Refs,'Unneeded reference "'+GetObjName(Ref.Element)+'"');
+        end;
+    finally
+      Refs.Free;
+    end;
+  end;
+
+  function FindProc(Section: TPasSection): boolean;
+  var
+    i: Integer;
+    El: TPasElement;
+    Proc: TPasProcedure;
+    Scope: TPasProcedureScope;
+  begin
+    for i:=0 to Section.Declarations.Count-1 do
+      begin
+      El:=TPasElement(Section.Declarations[i]);
+      if CompareText(El.Name,ProcName)<>0 then continue;
+      if not (El is TPasProcedure) then
+        Fail('El is not proc '+GetObjName(El));
+      Proc:=TPasProcedure(El);
+      Scope:=Proc.CustomData as TPasProcedureScope;
+      if Scope.DeclarationProc<>nil then continue;
+      Analyzer.Clear;
+      Analyzer.AnalyzeProcRefs(Proc);
+      CheckRefs(Scope);
+      exit(true);
+      end;
+    Result:=false;
+  end;
+
+var
+  i: Integer;
+begin
+  ParseUnit;
+
+  SetLength(Entries,High(RefNames)-low(RefNames)+1);
+  for i:=low(RefNames) to high(RefNames) do
+    begin
+    Entries[i].Name:=RefNames[i];
+    Entries[i].Access:=psraNone;
+    end;
+
+  if Module is TPasProgram then
+    begin
+    if FindProc(TPasProgram(Module).ProgramSection) then exit;
+    end
+  else if Module is TPasLibrary then
+    begin
+    if FindProc(TPasLibrary(Module).LibrarySection) then exit;
+    end
+  else if Module.ClassType=TPasModule then
+    begin
+    if FindProc(Module.InterfaceSection) then exit;
+    if FindProc(Module.ImplementationSection) then exit;
+    end;
+  Fail('missing proc '+ProcName);
+end;
+
 function TCustomTestUseAnalyzer.PAMessageCount: integer;
 begin
   Result:=FPAMessages.Count;
@@ -2092,8 +2230,34 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestPR_UnitVar;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TColor = longint;',
+  '  TIntColor = TColor;',
+  'var',
+  '  i: longint;',
+  '  j: longint;',
+  'procedure DoIt;',
+  'implementation',
+  'procedure DoIt;',
+  'type',
+  '  TSubColor = TIntColor;',
+  'var',
+  '  b: TSubColor;',
+  'begin',
+  '  b:=i;',
+  'end;',
+  '']);
+  CheckUnitProcedureReferences('DoIt',['i','tintcolor']);
+end;
+
 initialization
   RegisterTests([TTestUseAnalyzer]);
 
 end.
 
+