codetools: FindAbstractMethods: search class interfaces

git-svn-id: trunk@45593 -

components/codetools/basiccodetools.pas

@@ -1726,7 +1726,8 @@ var
   AtomStart: integer;
 begin
   Result:=FindFirstProcSpecifier(ProcText,NestedComments);
-  while Result<=length(ProcText) do begin
+  repeat
+    if Result>length(ProcText) then exit(-1);
     ReadRawNextPascalAtom(ProcText,Result,AtomStart,NestedComments,true);
     if AtomStart>length(ProcText) then exit(-1);
     if CompareIdentifiers(@ProcText[AtomStart],@Specifier[1])=0 then begin
@@ -1738,7 +1739,7 @@ begin
       then
         exit(-1);
     end;
-  end;
+  until false;
   SpecifierEndPosition:=Result;
   while (SpecifierEndPosition<=length(ProcText))
   and (ProcText[SpecifierEndPosition]<>';') do begin

components/codetools/codecompletiontool.pas

@@ -8943,6 +8943,7 @@ begin
         if VirtualToOverride then begin
           VirtualStartPos:=SearchProcSpecifier(FullProcCode,'virtual',
                           VirtualEndPos,NewCodeTool.Scanner.NestedComments);
+          debugln(['TCodeCompletionCodeTool.AddMethods FullProcCode="',FullProcCode,'" VirtualStartPos=',VirtualStartPos]);
           if VirtualStartPos>=1 then begin
             // replace virtual with override
             FullProcCode:=copy(FullProcCode,1,VirtualStartPos-1)

components/codetools/finddeclarationtool.pas

@@ -26,7 +26,6 @@
 
 
   ToDo:
-    - find declaration in dead code (started)
     - high type expression evaluation
       (i.e. at the moment: integer+integer=longint
                    wanted: integer+integer=integer)
@@ -693,6 +692,7 @@ type
     function FindClassMember(aClassNode: TCodeTreeNode; Identifier: PChar): TCodeTreeNode;
     function FindForwardIdentifier(Params: TFindDeclarationParams;
       var IsForward: boolean): boolean;
+    function FindNonForwardClass(ForwardNode: TCodeTreeNode): TCodeTreeNode;
     function FindNonForwardClass(Params: TFindDeclarationParams): boolean;
     function FindCodeToolForUsedUnit(const AnUnitName, AnUnitInFilename: string;
       ExceptionOnNotFound: boolean): TFindDeclarationTool;
@@ -5918,24 +5918,26 @@ begin
   Params.Load(OldInput,true);
 end;
 
-function TFindDeclarationTool.FindNonForwardClass(Params: TFindDeclarationParams
+function TFindDeclarationTool.FindNonForwardClass(ForwardNode: TCodeTreeNode
-  ): boolean;
+  ): TCodeTreeNode;
 var
   Node: TCodeTreeNode;
+  Identifier: PChar;
 begin
-  Result:=false;
+  Result:=nil;
-  Node:=Params.NewNode;
+  Node:=ForwardNode;
   if Node.Desc=ctnGenericType then begin
     Node:=Node.FirstChild;
     if Node=nil then exit;
   end else if Node.Desc<>ctnTypeDefinition then
     exit;
   Node:=Node.FirstChild;
+  Identifier:=@Src[Node.StartPos];
   if (Node=nil)
   or (not (Node.Desc in AllClasses))
   or ((ctnsForwardDeclaration and Node.SubDesc)=0) then
     exit;
-  Node:=Params.NewNode;
+  Node:=ForwardNode;
   repeat
     //DebugLn(['TFindDeclarationTool.FindNonForwardClass Node=',dbgstr(copy(Src,Node.StartPos,20))]);
     if Node.NextBrother<>nil then
@@ -5952,14 +5954,27 @@ begin
       if Node=nil then break;
       Node:=Node.FirstChild;
     end;
-    if CompareSrcIdentifiers(Node.StartPos,Params.Identifier) then begin
+    if CompareSrcIdentifiers(Node.StartPos,Identifier) then begin
-      Params.SetResult(Self,Node,Node.StartPos);
+      Result:=Node;
-      Result:=true;
       exit;
     end;
   until false;
 end;
 
+function TFindDeclarationTool.FindNonForwardClass(Params: TFindDeclarationParams
+  ): boolean;
+var
+  Node: TCodeTreeNode;
+begin
+  Node:=FindNonForwardClass(Params.NewNode);
+  if Node<>nil then begin
+    Params.SetResult(Self,Node,Node.StartPos);
+    Result:=true;
+  end else begin
+    Result:=false;
+  end;
+end;
+
 function TFindDeclarationTool.FindIdentifierInWithVarContext(
   WithVarNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
 { this function is internally used by FindIdentifierInContext }

components/codetools/identcompletiontool.pas

@@ -386,10 +386,6 @@ type
       const FoundContext: TFindContext): TIdentifierFoundResult;
     procedure AddCollectionContext(Tool: TFindDeclarationTool;
       Node: TCodeTreeNode);
-    procedure InitFoundMethods;
-    procedure ClearFoundMethods;
-    function CollectMethods(Params: TFindDeclarationParams;
-      const FoundContext: TFindContext): TIdentifierFoundResult;
     function IsInCompilerDirective(CursorPos: TCodeXYPosition): boolean;
     procedure AddCompilerDirectiveMacros(Directive: string);
   public
@@ -2049,52 +2045,6 @@ begin
   //DebugLn('TIdentCompletionTool.AddCollectionContext ',Node.DescAsString,' ',ExtractNode(Node,[]));
 end;
 
-procedure TIdentCompletionTool.InitFoundMethods;
-begin
-  if FIDTFoundMethods<>nil then ClearFoundMethods;
-  FIDTFoundMethods:=TAVLTree.Create(@CompareCodeTreeNodeExt);
-end;
-
-procedure TIdentCompletionTool.ClearFoundMethods;
-begin
-  if FIDTFoundMethods=nil then exit;
-  FreeAndNil(FIDTFoundMethods);
-end;
-
-function TIdentCompletionTool.CollectMethods(
-  Params: TFindDeclarationParams; const FoundContext: TFindContext
-  ): TIdentifierFoundResult;
-var
-  ProcText: String;
-  AVLNode: TAVLTreeNode;
-  NodeExt: TCodeTreeNodeExtension;
-begin
-  // proceed searching ...
-  Result:=ifrProceedSearch;
-
-  {$IFDEF ShowFoundIdents}
-  //if FoundContext.Tool=Self then
-  DebugLn('::: COLLECT IDENT ',FoundContext.Node.DescAsString,
-    ' "',StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)),'"');
-  {$ENDIF}
-  
-  if FoundContext.Node.Desc=ctnProcedure then begin
-    ProcText:=FoundContext.Tool.ExtractProcHead(FoundContext.Node,
-                              [phpWithoutClassKeyword,phpWithHasDefaultValues]);
-    AVLNode:=FindCodeTreeNodeExtAVLNode(FIDTFoundMethods,ProcText);
-    if AVLNode<>nil then begin
-      // method is overriden => ignore
-    end else begin
-      // new method
-      NodeExt:=TCodeTreeNodeExtension.Create;
-      NodeExt.Node:=FoundContext.Node;
-      NodeExt.Data:=FoundContext.Tool;
-      NodeExt.Txt:=ProcText;
-      FIDTFoundMethods.Add(NodeExt);
-    end;
-  end;
-end;
-
 function TIdentCompletionTool.IsInCompilerDirective(CursorPos: TCodeXYPosition
   ): boolean;
 var
@@ -2873,22 +2823,183 @@ end;
 function TIdentCompletionTool.FindAbstractMethods(
   const CursorPos: TCodeXYPosition; out ListOfPCodeXYPosition: TFPList;
   SkipAbstractsInStartClass: boolean): boolean;
+const
+  ProcAttr = [phpWithoutClassKeyword,phpWithHasDefaultValues];
+  FlagIsAbstract = 0;
+  FlagIsImplemented = 1;
+var
+  ImplementedInterfaces: TStringToPointerTree;
+  SearchedAncestors: TAVLTree;
+  Procs: TAVLTree; // tree of TCodeTreeNodeExtension
+
+  procedure AddProc(ATool: TFindDeclarationTool; ProcNode: TCodeTreeNode;
+    IsAbstract: boolean);
+  var
+    ProcText: String;
+    AVLNode: TAVLTreeNode;
+    NodeExt: TCodeTreeNodeExtension;
+  begin
+    ProcText:=ATool.ExtractProcHead(ProcNode,ProcAttr);
+    AVLNode:=FindCodeTreeNodeExtAVLNode(Procs,ProcText);
+    if AVLNode<>nil then begin
+      // known proc
+      NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
+      //debugln(['AddProc "',ProcText,'" WasImplemented=',NodeExt.Flags=1,' IsAbstract=',IsAbstract]);
+      if NodeExt.Flags=FlagIsImplemented then
+        exit; // already implemented
+      if IsAbstract then
+        exit; // already abstract
+      NodeExt.Flags:=FlagIsImplemented;
+      NodeExt.Node:=ProcNode;
+      NodeExt.Data:=ATool;
+    end else begin
+      // new method
+      //debugln(['AddProc "',ProcText,'" New IsAbstract=',IsAbstract]);
+      NodeExt:=TCodeTreeNodeExtension.Create;
+      NodeExt.Node:=ProcNode;
+      NodeExt.Data:=ATool;
+      NodeExt.Txt:=ProcText;
+      if IsAbstract then
+        NodeExt.Flags:=FlagIsAbstract
+      else
+        NodeExt.Flags:=FlagIsImplemented;
+      Procs.Add(NodeExt);
+    end;
+  end;
+
+  procedure CollectImplements(ClassNode: TCodeTreeNode);
+  var
+    Node: TCodeTreeNode;
+    StopNode: TCodeTreeNode;
+    InterfaceName: String;
+  begin
+    Node:=ClassNode.FirstChild;
+    StopNode:=ClassNode.NextSkipChilds;
+    while Node<>StopNode do begin
+      if Node.Desc in AllClassBaseSections then begin
+        Node:=Node.Next;
+        continue;
+      end else if Node.Desc=ctnProperty then begin
+        if PropertyHasSpecifier(Node,'IMPLEMENTS',false) then begin
+          ReadNextAtom;
+          while AtomIsIdentifier do begin
+            InterfaceName:=GetAtom;
+            ReadNextAtom;
+            if CurPos.Flag=cafPoint then begin
+              ReadNextAtom;
+              AtomIsIdentifierE(true);
+              InterfaceName+='.'+GetAtom;
+              ReadNextAtom;
+            end;
+            //debugln(['CollectImplements ',InterfaceName]);
+            ImplementedInterfaces[InterfaceName]:=Node;
+            if CurPos.Flag<>cafComma then break;
+            ReadNextAtom;
+          end;
+        end;
+      end else if Node.Desc=ctnProcedure then begin
+        if ProcNodeHasSpecifier(Node,psABSTRACT) then begin
+          if not SkipAbstractsInStartClass then
+            AddProc(Self,Node,true);
+        end else begin
+          AddProc(Self,Node,false);
+        end;
+      end;
+      Node:=Node.NextSkipChilds;
+    end;
+  end;
+
+  procedure CollectAncestors(aTool: TFindDeclarationTool;
+    ClassNode: TCodeTreeNode; IsStartClass: boolean); forward;
+
+  procedure CollectAncestor(ATool: TFindDeclarationTool;
+    InheritanceNode: TCodeTreeNode; SearchedAncestors: TAVLTree;
+    IsStartClass: boolean);
+  var
+    Params: TFindDeclarationParams;
+    ClassNode: TCodeTreeNode;
+    StopNode: TCodeTreeNode;
+    Node: TCodeTreeNode;
+    IsInterface: Boolean;
+  begin
+    //debugln(['CollectAncestor Ancestor=',ATool.ExtractIdentifierWithPoints(InheritanceNode.StartPos,false)]);
+    Params:=TFindDeclarationParams.Create;
+    try
+      if not ATool.FindAncestorOfClassInheritance(InheritanceNode,Params,true)
+      then exit;
+      ATool:=Params.NewCodeTool;
+      ClassNode:=Params.NewNode;
+      if SearchedAncestors.Find(ClassNode)<>nil then
+        exit; // already searched
+      SearchedAncestors.Add(ClassNode);
+      // check all procs of this ancestor
+      StopNode:=ClassNode.NextSkipChilds;
+      Node:=ClassNode.FirstChild;
+      IsInterface:=ClassNode.Desc in AllClassInterfaces;
+      if IsInterface and (not IsStartClass) then
+        exit;
+      while Node<>StopNode do begin
+        if Node.Desc in AllClassBaseSections then begin
+          Node:=Node.Next;
+          continue;
+        end else if Node.Desc=ctnProcedure then begin
+          if IsInterface
+          or ATool.ProcNodeHasSpecifier(Node,psABSTRACT) then
+            AddProc(ATool,Node,true)
+          else
+            AddProc(ATool,Node,false);
+        end;
+        Node:=Node.NextSkipChilds;
+      end;
+      CollectAncestors(ATool,ClassNode,false);
+    finally
+      Params.Free;
+    end;
+  end;
+
+  procedure CollectAncestors(aTool: TFindDeclarationTool;
+    ClassNode: TCodeTreeNode; IsStartClass: boolean);
+  var
+    InheritanceNode: TCodeTreeNode;
+    AncestorName: String;
+    Node: TCodeTreeNode;
+  begin
+    //debugln(['CollectAncestors of Class=',aTool.ExtractClassName(ClassNode,false)]);
+    InheritanceNode:=ATool.FindInheritanceNode(ClassNode);
+    if (InheritanceNode=nil)
+    or (InheritanceNode.FirstChild=nil) then begin
+      // no ancestors
+      exit;
+    end;
+    Node:=InheritanceNode.FirstChild;
+    while Node<>nil do begin
+      InheritanceNode:=Node;
+      Node:=Node.NextBrother;
+      if InheritanceNode.Desc=ctnIdentifier then begin
+        if IsStartClass then begin
+          AncestorName:=ATool.ExtractIdentifierWithPoints(InheritanceNode.StartPos,true);
+          if ImplementedInterfaces.FindNode(AncestorName)<>nil then
+            continue;
+        end;
+        CollectAncestor(ATool,InheritanceNode,SearchedAncestors,IsStartClass);
+      end;
+    end;
+  end;
+
 var
   CleanCursorPos: integer;
   CursorNode: TCodeTreeNode;
-  Params: TFindDeclarationParams;
+  ClassNode: TCodeTreeNode;
   AVLNode: TAVLTreeNode;
   NodeExt: TCodeTreeNodeExtension;
-  ATool: TFindDeclarationTool;
-  ANode: TCodeTreeNode;
   ProcXYPos: TCodeXYPosition;
-  Skip: Boolean;
+  ATool: TFindDeclarationTool;
-  ClassNode: TCodeTreeNode;
 begin
   Result:=false;
   ListOfPCodeXYPosition:=nil;
-  ActivateGlobalWriteLock;
+  ImplementedInterfaces:=nil;
-  Params:=nil;
+  Procs:=nil;
+  SearchedAncestors:=nil;
   try
     BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
                             [btSetIgnoreErrorPos]);
@@ -2903,6 +3014,7 @@ begin
       CursorNode:=CursorNode.LastChild
     else
       CursorNode:=FindClassOrInterfaceNode(CursorNode);
+
     if (CursorNode=nil)
     or (not (CursorNode.Desc in AllClassObjects))
     or ((CursorNode.SubDesc and ctnsForwardDeclaration)>0) then begin
@@ -2911,40 +3023,34 @@ begin
     end;
     ClassNode:=CursorNode;
 
-    Params:=TFindDeclarationParams.Create;
+    // search class for implemented interfaces and method
-    // gather all identifiers in context
+    ImplementedInterfaces:=TStringToPointerTree.Create(false);
-    Params.ContextNode:=ClassNode;
+    Procs:=TAVLTree.Create(@CompareCodeTreeNodeExt);
-    Params.SetIdentifier(Self,nil,@CollectMethods);
+    CollectImplements(ClassNode);
-    Params.Flags:=[fdfSearchInAncestors,fdfCollect,fdfFindVariable];
-    InitFoundMethods;
-    FindIdentifierInContext(Params);
 
-    if FIDTFoundMethods<>nil then begin
+    // search all ancestors
-      AVLNode:=FIDTFoundMethods.FindLowest;
+    SearchedAncestors:=TAVLTree.Create;
+    SearchedAncestors.Add(ClassNode);
+    CollectAncestors(Self,ClassNode,true);
+
+    // AddCodePosition for each abstract method
+    AVLNode:=Procs.FindLowest;
     while AVLNode<>nil do begin
       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
-        ANode:=NodeExt.Node;
+      if NodeExt.Flags=FlagIsAbstract then begin
         ATool:=TFindDeclarationTool(NodeExt.Data);
-        //DebugLn(['TIdentCompletionTool.FindAbstractMethods ',NodeExt.Txt,' ',ATool.ProcNodeHasSpecifier(ANode,psABSTRACT)]);
+        if not ATool.CleanPosToCaret(NodeExt.Node.StartPos,ProcXYPos) then
-        Skip:=false;
-        if not ATool.ProcNodeHasSpecifier(ANode,psABSTRACT) then
-          Skip:=true;
-        if SkipAbstractsInStartClass and (ANode.HasAsParent(ClassNode)) then
-          Skip:=true;
-        if not Skip then begin
-          if not ATool.CleanPosToCaret(ANode.StartPos,ProcXYPos) then
           raise Exception.Create('TIdentCompletionTool.FindAbstractMethods inconsistency');
         AddCodePosition(ListOfPCodeXYPosition,ProcXYPos);
       end;
-        AVLNode:=FIDTFoundMethods.FindSuccessor(AVLNode);
+      AVLNode:=Procs.FindSuccessor(AVLNode);
-      end;
     end;
 
     Result:=true;
   finally
-    Params.Free;
+    DisposeAVLTree(Procs);
-    ClearFoundMethods;
+    ImplementedInterfaces.Free;
-    DeactivateGlobalWriteLock;
+    SearchedAncestors.Free;
   end;
 end;
 

components/codetools/pascalreadertool.pas

@@ -80,6 +80,8 @@ type
         Attr: TProcHeadAttributes): string;
     function ExtractBrackets(BracketStartPos: integer;
         Attr: TProcHeadAttributes): string;
+    function ExtractIdentifierWithPoints(StartPos: integer;
+        ExceptionOnError: boolean): string;
     function ExtractIdentCharsFromStringConstant(
         StartPos, MinPos, MaxPos, MaxLen: integer): string;
     function ReadStringConstantValue(StartPos: integer): string;
@@ -112,7 +114,7 @@ type
     function PropertyNodeHasParamList(PropNode: TCodeTreeNode): boolean;
     function PropNodeIsTypeLess(PropNode: TCodeTreeNode): boolean;
     function PropertyHasSpecifier(PropNode: TCodeTreeNode;
-                 s: string; ExceptionOnNotFound: boolean = true): boolean;
+                 UpperKeyword: string; ExceptionOnNotFound: boolean = true): boolean;
 
     // procs
     function ExtractProcName(ProcNode: TCodeTreeNode;
@@ -1392,6 +1394,24 @@ begin
   Result:=GetExtraction(phpInUpperCase in Attr);
 end;
 
+function TPascalReaderTool.ExtractIdentifierWithPoints(StartPos: integer;
+  ExceptionOnError: boolean): string;
+begin
+  Result:='';
+  MoveCursorToCleanPos(StartPos);
+  ReadNextAtom;
+  if not AtomIsIdentifierE(ExceptionOnError) then exit;
+  Result:=GetAtom;
+  repeat
+    ReadNextAtom;
+    if CurPos.Flag<>cafPoint then
+      exit;
+    ReadNextAtom;
+    if not AtomIsIdentifierE(ExceptionOnError) then exit;
+    Result+='.'+GetAtom;
+  until false;
+end;
+
 function TPascalReaderTool.ExtractPropName(PropNode: TCodeTreeNode;
   InUpperCase: boolean): string;
 begin
@@ -2867,7 +2887,8 @@ begin
 end;
 
 function TPascalReaderTool.PropertyHasSpecifier(PropNode: TCodeTreeNode;
-  s: string; ExceptionOnNotFound: boolean): boolean;
+  UpperKeyword: string; ExceptionOnNotFound: boolean): boolean;
+// true if cursor is on keyword
 begin
 
   // ToDo: ppu, dcu
@@ -2892,12 +2913,12 @@ begin
     end;
   end;
 
-  s:=UpperCaseStr(s);
+  UpperKeyword:=UpperCaseStr(UpperKeyword);
   // read specifiers
   while not (CurPos.Flag in [cafSemicolon,cafNone]) do begin
     if WordIsPropertySpecifier.DoIdentifier(@Src[CurPos.StartPos])
     then begin
-      if UpAtomIs(s) then exit(true);
+      if UpAtomIs(UpperKeyword) then exit(true);
     end else if CurPos.Flag=cafEdgedBracketOpen then begin
       if not ReadTilBracketClose(ExceptionOnNotFound) then exit;
       ReadNextAtom;
@@ -2909,9 +2930,9 @@ begin
     ReadNextAtom;
     if UpAtomIs('DEFAULT') or UpAtomIs('NODEFAULT') or UpAtomIs('DEPRECATED')
     then begin
-      if CompareIdentifierPtrs(@Src[CurPos.StartPos],Pointer(s))=0 then exit(true);
+      if CompareIdentifierPtrs(@Src[CurPos.StartPos],Pointer(UpperKeyword))=0 then exit(true);
     end else if UpAtomIs('ENUMERATOR') then begin
-      if CompareIdentifierPtrs(@Src[CurPos.StartPos],Pointer(s))=0 then exit(true);
+      if CompareIdentifierPtrs(@Src[CurPos.StartPos],Pointer(UpperKeyword))=0 then exit(true);
       ReadNextAtom;
       if not AtomIsIdentifier then exit;
     end else

ide/abstractsmethodsdlg.pas

@@ -117,7 +117,7 @@ begin
     
     // check cursor is in a class
     if not CodeToolBoss.FindAbstractMethods(Code,Caret.X,Caret.Y,
-      ListOfPCodeXYPosition,false) then
+      ListOfPCodeXYPosition,true) then
     begin
       DebugLn(['ShowAbstractMethodsDialog CodeToolBoss.FindAbstractMethods failed']);
       if CodeToolBoss.ErrorMessage<>'' then begin