codetools: added class ancestor nodes

git-svn-id: trunk@19717 -

components/codetools/codetree.pas

@@ -82,19 +82,20 @@ const
 
   ctnClass              = 30;
   ctnClassInterface     = 31;
-  ctnClassGUID          = 32;
-  ctnClassTypePrivate   = 33;
-  ctnClassTypeProtected = 34;
-  ctnClassTypePublic    = 35;
-  ctnClassTypePublished = 36;
-  ctnClassVarPrivate    = 37;
-  ctnClassVarProtected  = 38;
-  ctnClassVarPublic     = 39;
-  ctnClassVarPublished  = 40;
-  ctnClassPrivate       = 41;
-  ctnClassProtected     = 42;
-  ctnClassPublic        = 43;
-  ctnClassPublished     = 44;
+  ctnClassInheritance   = 32;
+  ctnClassGUID          = 33;
+  ctnClassTypePrivate   = 34;
+  ctnClassTypeProtected = 35;
+  ctnClassTypePublic    = 36;
+  ctnClassTypePublished = 37;
+  ctnClassVarPrivate    = 38;
+  ctnClassVarProtected  = 39;
+  ctnClassVarPublic     = 40;
+  ctnClassVarPublished  = 41;
+  ctnClassPrivate       = 42;
+  ctnClassProtected     = 43;
+  ctnClassPublic        = 44;
+  ctnClassPublished     = 45;
 
   ctnProperty           = 50;
   ctnMethodMap          = 51;
@@ -354,6 +355,7 @@ begin
 
   ctnClass: Result:='Class';
   ctnClassInterface: Result:='Class Interface';
+  ctnClassInheritance: Result:='Class inheritance';
   ctnClassGUID: Result:='GUID';
   ctnClassPublished: Result:='Published';
   ctnClassPrivate: Result:='Private';

components/codetools/finddeclarationtool.pas

@@ -4374,11 +4374,12 @@ end;
 
 function TFindDeclarationTool.FindAncestorOfClass(ClassNode: TCodeTreeNode;
   Params: TFindDeclarationParams; FindClassContext: boolean): boolean;
-var AncestorAtom: TAtomPosition;
+var
   OldInput: TFindDeclarationInput;
   AncestorNode, ClassIdentNode: TCodeTreeNode;
   SearchBaseClass: boolean;
   AncestorContext: TFindContext;
+  AncestorStartPos: LongInt;
 begin
   {$IFDEF CheckNodeTool}CheckNodeTool(ClassNode);{$ENDIF}
   if (ClassNode=nil) or (not (ClassNode.Desc in [ctnClass,ctnClassInterface]))
@@ -4388,26 +4389,30 @@ begin
   Result:=false;
   
   // ToDo: ppu, ppw, dcu
-  
+
   // search the ancestor name
-  MoveCursorToNodeStart(ClassNode);
-  ReadNextAtom; // read keyword 'class', 'object', 'interface', 'dispinterface'
-  if UpAtomIs('PACKED') or (UpAtomIs('BITPACKED')) then ReadNextAtom;
-  ReadNextAtom;
   ClassIdentNode:=ClassNode.Parent;
-  if (ClassIdentNode<>nil) and (ClassIdentNode.Desc=ctnGenericType) then
-    ClassIdentNode:=ClassIdentNode.FirstChild;
-  if AtomIsChar('(') then begin
+
+  if (ClassNode.FirstChild<>nil)
+  and (ClassNode.FirstChild.Desc=ctnClassInheritance)
+  and (ClassNode.FirstChild.FirstChild<>nil) then begin
+    MoveCursorToCleanPos(ClassNode.FirstChild.FirstChild.StartPos);
+    AncestorStartPos:=CurPos.StartPos;
     ReadNextAtom;
-    if not AtomIsIdentifier(false) then exit;
-    // ancestor name found
-    AncestorAtom:=CurPos;
+    AtomIsIdentifier(true);
+    ReadNextAtom;
+    if CurPos.Flag=cafPoint then begin
+      ReadNextAtom;
+      AtomIsIdentifier(true);
+      AncestorStartPos:=CurPos.StartPos;
+    end;
     SearchBaseClass:=false;
     if (ClassIdentNode<>nil)
-    and (CompareIdentifiers(@Src[CurPos.StartPos],
+    and (ClassIdentNode.Desc=ctnTypeDefinition)
+    and (CompareIdentifiers(@Src[AncestorStartPos],
       @Src[ClassIdentNode.StartPos])=0)
     then begin
-      MoveCursorToCleanPos(CurPos.StartPos);
+      MoveCursorToCleanPos(AncestorStartPos);
       RaiseException('ancestor has same name as class');
     end;
   end else begin
@@ -4422,7 +4427,7 @@ begin
     if ClassNode.Desc=ctnClass then begin
       // if this class is not TObject, TObject is class ancestor
       SearchBaseClass:=
-                    not CompareSrcIdentifier(ClassIdentNode.StartPos,'TObject');
+                  not CompareSrcIdentifier(ClassIdentNode.StartPos,'TObject');
     end else begin
       // Delphi has as default interface IInterface
       // FPC has as interface IUnknown
@@ -4434,18 +4439,17 @@ begin
   end;
   {$IFDEF ShowTriedContexts}
   DebugLn('[TFindDeclarationTool.FindAncestorOfClass] ',
-  ' search ancestor class = ',GetAtom);
+  ' search ancestor class = ',GetIdentifier(@Src[AncestorStartPos]));
   {$ENDIF}
 
   // search ancestor class context
-  CurPos.StartPos:=CurPos.EndPos;
   Params.Save(OldInput);
   Params.Flags:=[fdfSearchInParentNodes,fdfIgnoreCurContextNode,
                  fdfExceptionOnNotFound]
                 +(fdfGlobals*Params.Flags)
                 -[fdfTopLvlResolving];
   if not SearchBaseClass then
-    Params.SetIdentifier(Self,@Src[AncestorAtom.StartPos],nil)
+    Params.SetIdentifier(Self,@Src[AncestorStartPos],nil)
   else begin
     if ClassNode.Desc=ctnClass then
       Params.SetIdentifier(Self,'TObject',nil)

components/codetools/pascalparsertool.pas

@@ -204,6 +204,7 @@ type
     procedure ReadVariableType;
     function ReadTilTypeOfProperty(PropertyNode: TCodeTreeNode): boolean;
     procedure ReadGUID;
+    procedure ReadClassInheritance(CreateChildNodes: boolean);
   public
     CurSection: TCodeTreeNodeDesc;
 
@@ -629,8 +630,7 @@ begin
       RaiseClassKeyWordExpected;
     ReadNextAtom;
     if CurPos.Flag=cafRoundBracketOpen then
-      // read inheritage
-      ReadTilBracketClose(true)
+      ReadClassInheritance(true)
     else
       UndoReadNextAtom;
     // clear the last atoms
@@ -638,7 +638,7 @@ begin
     // start the first class section (always published)
     CreateChildNode;
     CurNode.Desc:=ctnClassPublished;
-    CurNode.StartPos:=CurPos.EndPos; // behind 'class'
+    CurNode.StartPos:=CurPos.EndPos; // behind 'class' including the space
     ReadNextAtom;
     if CurPos.Flag=cafEdgedBracketOpen then
       ReadGUID;
@@ -3368,12 +3368,11 @@ begin
   if (CurPos.Flag<>cafSemicolon) then begin
     if (CurPos.Flag=cafRoundBracketOpen) then begin
       // read inheritage brackets
-      ReadTilBracketClose(true);
+      ReadClassInheritance(ChildCreated);
       ReadNextAtom;
     end;
-    if CurPos.Flag=cafEdgedBracketOpen then begin
+    if CurPos.Flag=cafEdgedBracketOpen then
       ReadGUID;
-    end;
     // parse till "end" of class/object
     CurKeyWordFuncList:=ClassInterfaceKeyWordFuncList;
     try
@@ -4173,6 +4172,49 @@ begin
   ReadNextAtom;
 end;
 
+procedure TPascalParserTool.ReadClassInheritance(CreateChildNodes: boolean);
+// cursor must be the round bracket open
+// at the end cursor will be on round bracket close
+begin
+  // read inheritage
+  if CreateChildNodes then begin
+    CreateChildNode;
+    CurNode.Desc:=ctnClassInheritance;
+  end;
+  // read list of ancestors, interfaces
+  ReadNextAtom;
+  if CurPos.Flag<>cafRoundBracketClose then begin
+    repeat
+      // read Identifier or Unit.Identifier
+      AtomIsIdentifier(true);
+      if CreateChildNodes then begin
+        CreateChildNode;
+        CurNode.Desc:=ctnIdentifier;
+      end;
+      ReadNextAtom;
+      if CurPos.Flag=cafPoint then begin
+        ReadNextAtom;
+        AtomIsIdentifier(true);
+        ReadNextAtom;
+      end;
+      if CreateChildNodes then begin
+        CurNode.EndPos:=CurPos.EndPos;
+        EndChildNode;
+      end;
+      // read comma or )
+      if CurPos.Flag=cafRoundBracketClose then break;
+      if CurPos.Flag<>cafComma then
+        RaiseCharExpectedButAtomFound(')');
+      ReadNextAtom;
+    until false;
+  end;
+  // close ctnClassInheritance
+  if CreateChildNodes then begin
+    CurNode.EndPos:=CurPos.EndPos;
+    EndChildNode;
+  end;
+end;
+
 procedure TPascalParserTool.ValidateToolDependencies;
 begin