codetools: implemented complete gathering of identifiers in interface

git-svn-id: trunk@19647 -

components/codetools/finddeclarationcache.pas

@@ -43,12 +43,12 @@ uses
 
 type
   {
-    1. interface cache:
+    1. interface cache: (unit interfaces, not class interfaces)
       Every FindIdentifierInInterface call is cached
         - stores: Identifier -> Node+CleanPos
         - cache must be deleted, everytime the codetree is rebuild
            this is enough update, because it does only store internals
-       -> This will improve search time for interface requests
+       -> This improves search time for interface requests
   }
   PInterfaceIdentCacheEntry = ^TInterfaceIdentCacheEntry;
   TInterfaceIdentCacheEntry = record
@@ -56,21 +56,29 @@ type
     Node: TCodeTreeNode; // if node = nil then identifier does not exist in
                          //                    this interface
     CleanPos: integer;
+    Overloaded: PInterfaceIdentCacheEntry;
     NextEntry: PInterfaceIdentCacheEntry; // used by memory manager
   end;
 
+  { TInterfaceIdentifierCache }
+
   TInterfaceIdentifierCache = class
   private
+    FComplete: boolean;
     FItems: TAVLTree; // tree of TInterfaceIdentCacheEntry
     FTool: TPascalParserTool;
     function FindAVLNode(Identifier: PChar): TAVLTreeNode;
+    procedure SetComplete(const AValue: boolean);
   public
     function FindIdentifier(Identifier: PChar): PInterfaceIdentCacheEntry;
     procedure Add(Identifier: PChar; Node: TCodeTreeNode; CleanPos: integer);
     procedure Clear;
+    procedure ClearMissingIdentifiers;
     constructor Create(ATool: TPascalParserTool);
     destructor Destroy; override;
+    procedure ConsistencyCheck;
     property Tool: TPascalParserTool read FTool;
+    property Complete: boolean read FComplete write SetComplete;
   end;
 
   {
@@ -343,6 +351,10 @@ end;
 procedure TInterfaceIdentCacheEntryMemManager.DisposeEntry(
   Entry: PInterfaceIdentCacheEntry);
 begin
+  if Entry^.Overloaded<>nil then begin
+    DisposeEntry(Entry^.Overloaded);
+    Entry^.Overloaded:=nil;
+  end;
   if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
   begin
     // add Entry to Free list
@@ -411,6 +423,25 @@ begin
   end;
 end;
 
+procedure TInterfaceIdentifierCache.ClearMissingIdentifiers;
+var
+  Node: TAVLTreeNode;
+  NextNode: TAVLTreeNode;
+  Entry: PInterfaceIdentCacheEntry;
+begin
+  if FItems=nil then exit;
+  Node:=FItems.FindLowest;
+  while Node<>nil do begin
+    NextNode:=FItems.FindSuccessor(Node);
+    Entry:=PInterfaceIdentCacheEntry(Node.Data);
+    if Entry^.Node=nil then begin
+      FItems.Delete(Node);
+      InterfaceIdentCacheEntryMemManager.DisposeEntry(Entry);
+    end;
+    Node:=NextNode;
+  end;
+end;
+
 constructor TInterfaceIdentifierCache.Create(ATool: TPascalParserTool);
 begin
   inherited Create;
@@ -422,10 +453,39 @@ end;
 destructor TInterfaceIdentifierCache.Destroy;
 begin
   Clear;
-  if FItems<>nil then FItems.Free;
+  FreeAndNil(FItems);
   inherited Destroy;
 end;
 
+procedure TInterfaceIdentifierCache.ConsistencyCheck;
+var
+  Node: TAVLTreeNode;
+  Entry: PInterfaceIdentCacheEntry;
+begin
+  if FItems<>nil then begin
+    if FItems.ConsistencyCheck<>0 then
+      RaiseCatchableException('');
+    Node:=FItems.FindLowest;
+    while Node<>nil do begin
+      Entry:=PInterfaceIdentCacheEntry(Node.Data);
+      while Entry<>nil do begin
+        if (Entry^.Identifier=nil) or (Entry^.Identifier^=#0) then
+          RaiseCatchableException('');
+        if (Entry^.Node=nil) and Complete then
+          RaiseCatchableException('');
+        if (Entry^.Overloaded<>nil)
+        and (CompareIdentifiers(Entry^.Identifier,Entry^.Overloaded^.Identifier)<>0)
+        then begin
+          debugln(['TInterfaceIdentifierCache.ConsistencyCheck Entry=',GetIdentifier(Entry^.Identifier),'<>',GetIdentifier(Entry^.Overloaded^.Identifier)]);
+          RaiseCatchableException('');
+        end;
+        Entry:=Entry^.Overloaded;
+      end;
+      Node:=FItems.FindSuccessor(Node);
+    end;
+  end;
+end;
+
 function TInterfaceIdentifierCache.FindAVLNode(Identifier: PChar): TAVLTreeNode;
 var
   Entry: PInterfaceIdentCacheEntry;
@@ -448,6 +508,14 @@ begin
   end;
 end;
 
+procedure TInterfaceIdentifierCache.SetComplete(const AValue: boolean);
+begin
+  if FComplete=AValue then exit;
+  FComplete:=AValue;
+  if FComplete then
+    ClearMissingIdentifiers;
+end;
+
 function TInterfaceIdentifierCache.FindIdentifier(Identifier: PChar
   ): PInterfaceIdentCacheEntry;
 var Node: TAVLTreeNode;
@@ -463,17 +531,26 @@ procedure TInterfaceIdentifierCache.Add(Identifier: PChar; Node: TCodeTreeNode;
   CleanPos: integer);
 var
   NewEntry: PInterfaceIdentCacheEntry;
+  OldNode: TAVLTreeNode;
 begin
+  if (GetIdentLen(Identifier)=0) then
+    RaiseCatchableException('');
   if FItems=nil then
     FItems:=TAVLTree.Create(@CompareTInterfaceIdentCacheEntry);
+  OldNode:=FindAVLNode(Identifier);
   NewEntry:=InterfaceIdentCacheEntryMemManager.NewEntry;
   NewEntry^.Identifier:=GlobalIdentifierTree.AddCopy(Identifier);
   NewEntry^.Node:=Node;
   NewEntry^.CleanPos:=CleanPos;
-  FItems.Add(NewEntry);
+  if OldNode<>nil then begin
+    NewEntry^.Overloaded:=PInterfaceIdentCacheEntry(OldNode.Data);
+    OldNode.Data:=NewEntry;
+  end else begin
+    NewEntry^.Overloaded:=nil;
+    FItems.Add(NewEntry);
+  end;
 end;
 
-
 { TGlobalIdentifierTree }
 
 procedure TGlobalIdentifierTree.Clear;
@@ -512,7 +589,8 @@ begin
   Len:=0;
   while IsIdentChar[Identifier[Len]] do inc(Len);
   GetMem(Result,Len+1);
-  Move(Identifier^,Result^,Len+1);
+  Move(Identifier^,Result^,Len);
+  Result[Len]:=#0;
   if FItems=nil then
     FItems:=TAVLTree.Create(TListSortCompare(@CompareIdentifiers));
   FItems.Add(Result);

components/codetools/finddeclarationtool.pas

@@ -708,6 +708,7 @@ type
 
     procedure BeginParsing(DeleteNodes, OnlyInterfaceNeeded: boolean); override;
     procedure ValidateToolDependencies; override;
+    function BuildInterfaceIdentifierCache(ExceptionOnNotUnit: boolean): boolean;
     function FindDeclaration(const CursorPos: TCodeXYPosition;
       out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
     function FindMainDeclaration(const CursorPos: TCodeXYPosition;
@@ -4768,7 +4769,7 @@ function TFindDeclarationTool.FindIdentifierInUsesSection(
 { this function is internally used by FindIdentifierInContext
 
    search backwards through the uses section
-   compare first the unit name, then load the unit and search there
+   compare first the all unit names, then load the units and search there
 }
 var
   InAtom, UnitNameAtom: TAtomPosition;
@@ -4777,21 +4778,43 @@ var
 begin
   {$IFDEF CheckNodeTool}CheckNodeTool(UsesNode);{$ENDIF}
   Result:=false;
-  MoveCursorToUsesEnd(UsesNode);
+  // reparse uses section
+  MoveCursorToNodeStart(UsesNode);
+  if (UsesNode.Desc=ctnUsesSection) then begin
+    ReadNextAtom;
+    if not UpAtomIs('USES') then
+      RaiseUsesExpected;
+  end;
   repeat
-    ReadPriorUsedUnit(UnitNameAtom, InAtom);
+    ReadNextAtom;  // read name
+    if CurPos.StartPos>SrcLen then break;
+    if AtomIsChar(';') then break;
+    AtomIsIdentifier(true);
     if (Params.IdentifierTool=Self)
-    and CompareSrcIdentifiers(UnitNameAtom.StartPos,Params.Identifier) then
+    and CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then
     begin
       // the searched identifier was a uses unitname, point to the identifier in
       // the uses section
       Result:=true;
-      Params.SetResult(Self,UsesNode,UnitNameAtom.StartPos);
+      Params.SetResult(Self,UsesNode,CurPos.StartPos);
       exit;
     end;
-    if (fdfIgnoreUsedUnits in Params.Flags) then begin
+    ReadNextAtom;
-      // search further
+    if UpAtomIs('IN') then begin
-    end else begin
+      ReadNextAtom;
+      if not AtomIsStringConstant then RaiseStrConstExpected;
+      ReadNextAtom;
+    end;
+    if AtomIsChar(';') then break;
+    if not AtomIsChar(',') then
+      RaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom])
+  until (CurPos.StartPos>SrcLen);
+
+  if not (fdfIgnoreUsedUnits in Params.Flags) then begin
+    // search in units
+    MoveCursorToUsesEnd(UsesNode);
+    repeat
+      ReadPriorUsedUnit(UnitNameAtom, InAtom);
       // open the unit
       {$IFDEF ShowTriedUnits}
       DebugLn('TFindDeclarationTool.FindIdentifierInUsesSection Self=',MainFilename,
@@ -4808,9 +4831,9 @@ begin
       if Result and Params.IsFinal then exit;
       // restore the cursor
       MoveCursorToCleanPos(UnitNameAtom.StartPos);
-    end;
+      ReadPriorAtom; // read keyword 'uses' or comma
-    ReadPriorAtom; // read keyword 'uses' or comma
+    until not AtomIsChar(',');
-  until not AtomIsChar(',');
+  end;
 end;
 
 function TFindDeclarationTool.FindCodeToolForUsedUnit(UnitNameAtom,
@@ -4952,19 +4975,9 @@ end;
 
 function TFindDeclarationTool.FindIdentifierInInterface(
   AskingTool: TFindDeclarationTool; Params: TFindDeclarationParams): boolean;
-var InterfaceNode: TCodeTreeNode;
+var
-  SrcIsUsable: boolean;
-  OldInput: TFindDeclarationInput;
   CacheEntry: PInterfaceIdentCacheEntry;
-  
+  IdentFoundResult: TIdentifierFoundResult;
-  procedure RaiseWrongContext;
-  begin
-    DebugLn('TFindDeclarationTool.FindIdentifierInInterface.RaiseWrongContext');
-    Params.WriteDebugReport;
-    SaveRaiseException('TFindDeclarationTool.FindIdentifierInInterface '
-                      +'Internal Error: Wrong CodeTool');
-  end;
-  
 begin
   Result:=false;
   // build code tree
@@ -4978,78 +4991,109 @@ begin
   {$ENDIF}
 
   // ToDo: build codetree for ppu, ppw, dcu files
-  
+
   // build tree for pascal source
-  BuildTree(true);
+  if not BuildInterfaceIdentifierCache(true) then exit(false);
   if (AskingTool<>Self) and (AskingTool<>nil) then
     AskingTool.AddToolDependency(Self);
 
   // search identifier in cache
-  if (FInterfaceIdentifierCache<>nil)
+  CacheEntry:=FInterfaceIdentifierCache.FindIdentifier(Params.Identifier);
-  and (not (fdfCollect in Params.Flags)) then begin
+  while CacheEntry<>nil do begin
-    CacheEntry:=FInterfaceIdentifierCache.FindIdentifier(Params.Identifier);
+    Params.SetResult(Self,CacheEntry^.Node,CacheEntry^.CleanPos);
-    if CacheEntry<>nil then begin
+    IdentFoundResult:=DoOnIdentifierFound(Params,Params.NewNode);
-      // identifier in cache found
+    {$IFDEF ShowProcSearch}
-      {$IFDEF ShowInterfaceCache}
+    DebugLn(['[TFindDeclarationTool.FindIdentifierInContext.CheckResult] DoOnIdentifierFound=',IdentifierFoundResultNames[IdentFoundResult]]);
-      DebugLn('[TFindDeclarationTool.FindIdentifierInInterface] Ident already in cache:',
+    {$ENDIF}
-      ' Exists=',DbgS(CacheEntry^.Node<>nil));
+    if (IdentFoundResult=ifrSuccess) then
-      {$ENDIF}
+      exit(true);
-      if CacheEntry^.Node=nil then begin
+    if IdentFoundResult=ifrAbortSearch then exit(false);
-        // identifier not in this interface
+    // proceed
-      end else begin
+    CacheEntry:=CacheEntry^.Overloaded;
-        // identifier in this interface found
-        Params.SetResult(Self,CacheEntry^.Node,CacheEntry^.CleanPos);
-        Result:=true;
-      end;
-      exit;
-    end;
   end;
-  
+  exit(false);
-  // check source name
+end;
-  MoveCursorToNodeStart(Tree.Root);
-  ReadNextAtom; // read keyword for source type, e.g. 'unit'
-  SrcIsUsable:=UpAtomIs('UNIT');
-  if not SrcIsUsable then
-    RaiseException(ctsSourceIsNotUnit);
-  ReadNextAtom; // read source name
-  if CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then begin
-    // identifier is source name
-    Params.SetResult(Self,Tree.Root,CurPos.StartPos);
-    Result:=true;
-    exit;
-  end;
-  
-  // search identifier in interface
-  InterfaceNode:=FindInterfaceNode;
-  if InterfaceNode=nil then
-    RaiseException(ctsInterfaceSectionNotFound);
-  Params.Save(OldInput);
-  Params.Flags:=(fdfGlobalsSameIdent*Params.Flags)
-                -[fdfExceptionOnNotFound,fdfSearchInParentNodes]
-                +[fdfIgnoreUsedUnits];
-  Params.ContextNode:=InterfaceNode;
-  Result:=FindIdentifierInContext(Params);
-  Params.Load(OldInput,true);
 
-  // save result in cache
+function TFindDeclarationTool.BuildInterfaceIdentifierCache(
-  if Params.Flags*[fdfCollect,fdfDoNotCache]=[] then begin
+  ExceptionOnNotUnit: boolean): boolean;
-    if FInterfaceIdentifierCache=nil then
+
-      FInterfaceIdentifierCache:=TInterfaceIdentifierCache.Create(Self);
+  procedure ScanForEnums(Node: TCodeTreeNode);
-    if Result and (Params.NewCodeTool=Self) then begin
+  begin
-      // identifier exists in interface
+    while Node<>nil do begin
-      if (Params.NewNode<>nil) and (Params.NewNode.Desc=ctnProcedure) then begin
+      if Node.Desc=ctnEnumIdentifier then
-        //DebugLn('NOTE: TFindDeclarationTool.FindIdentifierInInterface Node is proc');
+        FInterfaceIdentifierCache.Add(@Src[Node.StartPos],Node,Node.StartPos);
-        // ToDo: add param list to cache
+      Node:=Node.Next;
-        // -> do not cache
-      end else begin
-        FInterfaceIdentifierCache.Add(OldInput.Identifier,Params.NewNode,
-          Params.NewCleanPos);
-      end;
-    end else if not Result then begin
-      // identifier does not exist in this interface
-      FInterfaceIdentifierCache.Add(OldInput.Identifier,nil,-1);
     end;
   end;
+
+  procedure ScanChilds(ParentNode: TCodeTreeNode);
+  var
+    Node: TCodeTreeNode;
+  begin
+    Node:=ParentNode.FirstChild;
+    while Node<>nil do begin
+      case Node.Desc of
+      ctnTypeSection,ctnConstSection,ctnVarSection,ctnResStrSection:
+        ScanChilds(Node);
+      ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition:
+        FInterfaceIdentifierCache.Add(@Src[Node.StartPos],Node,Node.StartPos);
+      ctnGenericType:
+        if Node.FirstChild<>nil then
+          FInterfaceIdentifierCache.Add(@Src[Node.FirstChild.StartPos],Node,Node.StartPos);
+      ctnProperty:
+        begin
+          MoveCursorToPropName(Node);
+          FInterfaceIdentifierCache.Add(@Src[CurPos.StartPos],Node,Node.StartPos);
+        end;
+      ctnProcedure:
+        if (Node.FirstChild<>nil) and (not NodeIsOperator(Node)) then
+          FInterfaceIdentifierCache.Add(@Src[Node.FirstChild.StartPos],Node,Node.StartPos);
+      end;
+      ScanForEnums(Node);
+      Node:=Node.NextBrother;
+    end;
+  end;
+
+var
+  InterfaceNode: TCodeTreeNode;
+begin
+  // build tree for pascal source
+  BuildTree(true);
+
+  // search interface section
+  InterfaceNode:=FindInterfaceNode;
+  if InterfaceNode=nil then begin
+    // check source type
+    if ExceptionOnNotUnit then begin
+      MoveCursorToNodeStart(Tree.Root);
+      ReadNextAtom; // read keyword for source type, e.g. 'unit'
+      if not UpAtomIs('UNIT') then
+        RaiseException(ctsSourceIsNotUnit);
+      RaiseException(ctsInterfaceSectionNotFound);
+    end else
+      exit(true);
+  end;
+
+  // create tree
+  if (FInterfaceIdentifierCache<>nil) and FInterfaceIdentifierCache.Complete then
+    exit(true);
+
+  if FInterfaceIdentifierCache=nil then
+    FInterfaceIdentifierCache:=TInterfaceIdentifierCache.Create(Self)
+  else
+    FInterfaceIdentifierCache.Clear;
+  FInterfaceIdentifierCache.Complete:=true;
+
+  // add unit node
+  MoveCursorToNodeStart(Tree.Root);
+  ReadNextAtom; // keyword unit
+  ReadNextAtom;
+  FInterfaceIdentifierCache.Add(@Src[CurPos.StartPos],Tree.Root,CurPos.StartPos);
+
+  // create nodes
+  ScanChilds(InterfaceNode);
+
+  Result:=true;
 end;
 
 function TFindDeclarationTool.CompareNodeIdentifier(Node: TCodeTreeNode;
@@ -5113,7 +5157,7 @@ begin
     DebugLn('WARNING: Searching again in hidden unit: "',NewCode.Filename,'"');
   end else begin
     // source found -> get codetool for it
-    {$IFDEF ShowTriedContexts}
+    {$IF defined(ShowTriedContexts) or defined(ShowTriedUnits)}
     DebugLn('[TFindDeclarationTool.FindIdentifierInUsedUnit] ',
     ' This source is=',TCodeBuffer(Scanner.MainCode).Filename,
     ' NewCode=',NewCode.Filename,' IgnoreUsedUnits=',dbgs(fdfIgnoreUsedUnits in Params.Flags));
@@ -7673,8 +7717,10 @@ end;
 procedure TFindDeclarationTool.DoDeleteNodes;
 begin
   ClearNodeCaches(true);
-  if FInterfaceIdentifierCache<>nil then
+  if FInterfaceIdentifierCache<>nil then begin
     FInterfaceIdentifierCache.Clear;
+    FInterfaceIdentifierCache.Complete:=false;
+  end;
   inherited DoDeleteNodes;
 end;
 
@@ -7862,9 +7908,8 @@ procedure TFindDeclarationTool.ConsistencyCheck;
 var ANodeCache: TCodeTreeNodeCache;
 begin
   inherited ConsistencyCheck;
-  if FInterfaceIdentifierCache<>nil then begin
+  if FInterfaceIdentifierCache<>nil then
-
+    FInterfaceIdentifierCache.ConsistencyCheck;
-  end;
   ANodeCache:=FFirstNodeCache;
   while ANodeCache<>nil do begin
     ANodeCache.ConsistencyCheck;

components/codetools/pascalreadertool.pas

@@ -111,6 +111,7 @@ type
     function NodeIsConstructor(ProcNode: TCodeTreeNode): boolean;
     function NodeIsDestructor(ProcNode: TCodeTreeNode): boolean;
     function NodeIsForwardProc(ProcNode: TCodeTreeNode): boolean;
+    function NodeIsOperator(ProcNode: TCodeTreeNode): boolean;
 
     // classes
     function ExtractClassName(ClassNode: TCodeTreeNode;
@@ -154,6 +155,7 @@ type
     function MoveCursorToParameterSpecifier(DefinitionNode: TCodeTreeNode
                                             ): boolean;
     function FindEndOfWithVar(WithVarNode: TCodeTreeNode): integer;
+    function NodeIsIdentifierInInterface(Node: TCodeTreeNode): boolean;
 
     // sections
     function GetSourceName(DoBuildTree: boolean = true): string;
@@ -1590,6 +1592,16 @@ begin
   if (ctnsForwardDeclaration and ProcNode.SubDesc)>0 then exit(true);
 end;
 
+function TPascalReaderTool.NodeIsOperator(ProcNode: TCodeTreeNode): boolean;
+begin
+  Result:=false;
+  if (ProcNode=nil) then exit;
+  if ProcNode.Desc=ctnProcedureHead then
+    ProcNode:=ProcNode.Parent;
+  if ProcNode.Desc<>ctnProcedure then exit;
+  Result:=CompareIdentifiers('operator',@Src[ProcNode.StartPos])=0;
+end;
+
 function TPascalReaderTool.NodeIsPartOfTypeDefinition(ANode: TCodeTreeNode
   ): boolean;
 begin
@@ -1674,6 +1686,30 @@ begin
   Result:=CurPos.EndPos;
 end;
 
+function TPascalReaderTool.NodeIsIdentifierInInterface(Node: TCodeTreeNode
+  ): boolean;
+begin
+  case Node.Desc of
+  ctnEnumIdentifier:
+    Result:=true;
+  ctnVarDefinition:
+    Result:=(Node.Parent.Desc=ctnVarSection)
+            and (Node.Parent.Parent.Desc=ctnInterface);
+  ctnConstDefinition:
+    Result:=(Node.Parent.Desc=ctnConstSection)
+            and (Node.Parent.Parent.Desc=ctnInterface);
+  ctnTypeDefinition,ctnGenericType:
+    Result:=(Node.Parent.Desc=ctnTypeSection)
+            and (Node.Parent.Parent.Desc=ctnInterface);
+  ctnProcedure,ctnProperty:
+    Result:=Node.Parent.Desc=ctnInterface;
+  ctnProcedureHead:
+    Result:=(Node.Parent.Desc=ctnProcedure)
+        and (Node.Parent.Parent.Desc=ctnInterface);
+  end;
+  Result:=false;
+end;
+
 function TPascalReaderTool.GetSourceName(DoBuildTree: boolean): string;
 var NamePos: TAtomPosition;
 begin