codetools: parsing specialize in class inheritage brackets, bug #15081

git-svn-id: trunk@22649 -

components/codetools/codecompletiontool.pas

@@ -374,14 +374,18 @@ begin
   end;
   ClearIgnoreErrorAfter;
   BuildSubTreeForClass(FCodeCompleteClassNode);
-  if FCodeCompleteClassNode.Desc in AllClassInterfaces then
+  // find first variable/method/GUID
-    FCompletingStartNode:=FCodeCompleteClassNode
+  FCompletingStartNode:=FCodeCompleteClassNode.FirstChild;
-  else
+  while FCompletingStartNode<>nil do begin
-    FCompletingStartNode:=FCodeCompleteClassNode.FirstChild;
+    if FCompletingStartNode.Desc in AllClassSections then
-  while (FCompletingStartNode<>nil) and (FCompletingStartNode.FirstChild=nil) do
+      FCompletingStartNode:=FCompletingStartNode.Next
-    FCompletingStartNode:=FCompletingStartNode.NextBrother;
+    else if FCompletingStartNode.Desc in (AllIdentifierDefinitions
-  if FCompletingStartNode<>nil then
+      +[ctnProperty,ctnProcedure])
-    FCompletingStartNode:=FCompletingStartNode.FirstChild;
+    then
+      break
+    else
+      FCompletingStartNode:=FCompletingStartNode.NextBrother;
+  end;
 end;
 
 procedure TCodeCompletionCodeTool.SetCodeCompleteSrcChgCache(

components/codetools/finddeclarationtool.pas

@@ -1280,8 +1280,7 @@ var CleanCursorPos: integer;
         // parse class and build CodeTreeNodes for all properties/methods
         BuildSubTreeForClass(ClassNode);
         CursorNode:=FindDeepestNodeAtPos(ClassNode,CleanCursorPos,true);
-        if (CursorNode.Desc=ctnClassInheritance)
+        if CursorNode.GetNodeOfType(ctnClassInheritance)<>nil then begin
-        or (CursorNode.Parent.Desc=ctnClassInheritance) then begin
           // identifier is an ancestor/interface identifier
           CursorNode:=ClassNode.Parent;
           DirectSearch:=true;
@@ -3812,8 +3811,7 @@ begin
 
     // find class node
     ANode:=FindDeepestNodeAtPos(CleanCursorPos,true);
-    if (ANode.Desc=ctnClassInheritance)
+    if (ANode.GetNodeOfType(ctnClassInheritance)<>nil) then
-    or ((ANode.Parent<>nil) and (ANode.Parent.Desc=ctnClassInheritance)) then
       exit;
     ClassNode:=FindClassNode(ANode);
     if (ClassNode=nil) or (ClassNode.Parent=nil)
@@ -4770,7 +4768,7 @@ var
 begin
   {$IFDEF CheckNodeTool}CheckNodeTool(IdentifierNode);{$ENDIF}
   if (IdentifierNode=nil)
-  or (IdentifierNode.Desc<>ctnIdentifier)
+  or (not (IdentifierNode.Desc in [ctnIdentifier,ctnSpecialize]))
   or (IdentifierNode.Parent=nil)
   or (IdentifierNode.Parent.Desc<>ctnClassInheritance)
   then
@@ -4781,7 +4779,16 @@ begin
   ClassNode:=IdentifierNode.Parent.Parent;
   ClassIdentNode:=ClassNode.Parent;
 
-  MoveCursorToCleanPos(IdentifierNode.StartPos);
+  if IdentifierNode.Desc=ctnSpecialize then begin
+    if (IdentifierNode.FirstChild=nil) then begin
+      MoveCursorToCleanPos(IdentifierNode.StartPos);
+      ReadNextAtom;
+      ReadNextAtom;
+      RaiseStringExpectedButAtomFound('class type');
+    end;
+    MoveCursorToCleanPos(IdentifierNode.FirstChild.StartPos);
+  end else
+    MoveCursorToCleanPos(IdentifierNode.StartPos);
   AncestorStartPos:=CurPos.StartPos;
   ReadNextAtom;
   AtomIsIdentifier(true);

components/codetools/identcompletiontool.pas

@@ -1587,10 +1587,8 @@ begin
     else
       GatherContext.Node:=GatherContext.Node.Parent;
   end
-  else if (GatherContext.Node.Desc=ctnClassInheritance)
+  else if (GatherContext.Node.GetNodeOfType(ctnClassInheritance)<>nil) then
-  or ((GatherContext.Node.Parent<>nil)
+  begin
-     and (GatherContext.Node.Parent.Desc=ctnClassInheritance))
-  then begin
     while not (GatherContext.Node.Desc in AllClasses) do
       GatherContext.Node:=GatherContext.Node.Parent;
     GatherContext.Node:=GatherContext.Node.Parent;

components/codetools/methodjumptool.pas

@@ -780,7 +780,6 @@ begin
   Result:=TAVLTree.Create(@CompareCodeTreeNodeExt);
   ANode:=StartNode;
   while (ANode<>nil) do begin
-    //DebugLn('[TMethodJumpingCodeTool.GatherProcNodes] A ',NodeDescriptionAsString(ANode.Desc));
     if ANode.Desc=ctnProcedure then begin
       if (not ((phpIgnoreForwards in Attr)
            and ((ANode.SubDesc and ctnsForwardDeclaration)>0)))

components/codetools/pascalparsertool.pas

@@ -201,6 +201,7 @@ type
     function ReadTilTypeOfProperty(PropertyNode: TCodeTreeNode): boolean;
     procedure ReadGUID;
     procedure ReadClassInheritance(CreateChildNodes: boolean);
+    procedure ReadSpecialize(CreateChildNodes: boolean);
     function WordIsPropertyEnd: boolean;
   public
     CurSection: TCodeTreeNodeDesc;
@@ -3309,61 +3310,8 @@ begin
 end;
 
 function TPascalParserTool.KeyWordFuncSpecialize: boolean;
-// specialize template
-// examples:
-//   type TListOfInteger = specialize TGenericList<integer,string>;
-//   type TListOfChar = specialize Classes.TGenericList<integer,objpas.integer>;
 begin
-  if (CurNode.Desc<>ctnTypeDefinition) then
+  ReadSpecialize(true);
-    SaveRaiseExceptionFmt(ctsAnonymDefinitionsAreNotAllowed,['specialize']);
-  CreateChildNode;
-  CurNode.Desc:=ctnSpecialize;
-  // read identifier (the name of the generic)
-  ReadNextAtom;
-  AtomIsIdentifier(true);
-  CreateChildNode;
-  CurNode.Desc:=ctnSpecializeType;
-  CurNode.EndPos:=CurPos.EndPos;
-  ReadNextAtom;
-  if Curpos.Flag=cafPoint then begin
-    // first identifier was unitname, now read the type
-    ReadNextAtom;
-    AtomIsIdentifier(true);
-    CurNode.EndPos:=CurPos.EndPos;
-    ReadNextAtom;
-  end;
-  EndChildNode;
-  // read type list
-  if not AtomIsChar('<') then
-    RaiseCharExpectedButAtomFound('<');
-  CreateChildNode;
-  CurNode.Desc:=ctnSpecializeParams;
-  // read list of types
-  repeat
-    // read identifier (a parameter of the generic type)
-    ReadNextAtom;
-    AtomIsIdentifier(true);
-    ReadNextAtom;
-    if Curpos.Flag=cafPoint then begin
-      // first identifier was unitname, now read the type
-      ReadNextAtom;
-      AtomIsIdentifier(true);
-      ReadNextAtom;
-    end;
-    if AtomIsChar('>') then
-      break
-    else if CurPos.Flag=cafComma then begin
-      // read next parameter
-    end else
-      RaiseCharExpectedButAtomFound('>');
-  until false;
-  // close list
-  CurNode.EndPos:=CurPos.EndPos;
-  EndChildNode;
-  // close specialize
-  CurNode.EndPos:=CurPos.EndPos;
-  EndChildNode;
-  ReadNextAtom;
   Result:=true;
 end;
 
@@ -4419,21 +4367,26 @@ begin
   ReadNextAtom;
   if CurPos.Flag<>cafRoundBracketClose then begin
     repeat
-      // read Identifier or Unit.Identifier
+      if UpAtomIs('SPECIALIZE') then begin
-      AtomIsIdentifier(true);
+        // specialize Identifier<Identifier>
-      if CreateChildNodes then begin
+        ReadSpecialize(CreateChildNodes);
-        CreateChildNode;
+      end else begin
-        CurNode.Desc:=ctnIdentifier;
+        // read Identifier or Unit.Identifier
-      end;
-      ReadNextAtom;
-      if CurPos.Flag=cafPoint then begin
-        ReadNextAtom;
         AtomIsIdentifier(true);
+        if CreateChildNodes then begin
+          CreateChildNode;
+          CurNode.Desc:=ctnIdentifier;
+        end;
         ReadNextAtom;
-      end;
+        if CurPos.Flag=cafPoint then begin
-      if CreateChildNodes then begin
+          ReadNextAtom;
-        CurNode.EndPos:=CurPos.EndPos;
+          AtomIsIdentifier(true);
-        EndChildNode;
+          ReadNextAtom;
+        end;
+        if CreateChildNodes then begin
+          CurNode.EndPos:=CurPos.EndPos;
+          EndChildNode;
+        end;
       end;
       // read comma or )
       if CurPos.Flag=cafRoundBracketClose then break;
@@ -4449,6 +4402,75 @@ begin
   end;
 end;
 
+procedure TPascalParserTool.ReadSpecialize(CreateChildNodes: boolean);
+// specialize template
+// after parsing the cursor is on the atom behind the >
+// examples:
+//   type TListOfInteger = specialize TGenericList<integer,string>;
+//   type TListOfChar = specialize Classes.TGenericList<integer,objpas.integer>;
+//   type l = class(specialize TFPGObjectList<TControl>)
+begin
+  if CreateChildNodes then begin
+    CreateChildNode;
+    CurNode.Desc:=ctnSpecialize;
+  end;
+  // read identifier (the name of the generic)
+  ReadNextAtom;
+  AtomIsIdentifier(true);
+  if CreateChildNodes then begin
+    CreateChildNode;
+    CurNode.Desc:=ctnSpecializeType;
+    CurNode.EndPos:=CurPos.EndPos;
+  end;
+  ReadNextAtom;
+  if Curpos.Flag=cafPoint then begin
+    // first identifier was unitname, now read the type
+    ReadNextAtom;
+    AtomIsIdentifier(true);
+    if CreateChildNodes then
+      CurNode.EndPos:=CurPos.EndPos;
+    ReadNextAtom;
+  end;
+  if CreateChildNodes then begin
+    EndChildNode; // end ctnSpecializeType
+  end;
+  // read type list
+  if not AtomIsChar('<') then
+    RaiseCharExpectedButAtomFound('<');
+  if CreateChildNodes then begin
+    CreateChildNode;
+    CurNode.Desc:=ctnSpecializeParams;
+  end;
+  // read list of types
+  repeat
+    // read identifier (a parameter of the generic type)
+    ReadNextAtom;
+    AtomIsIdentifier(true);
+    ReadNextAtom;
+    if Curpos.Flag=cafPoint then begin
+      // first identifier was unitname, now read the type
+      ReadNextAtom;
+      AtomIsIdentifier(true);
+      ReadNextAtom;
+    end;
+    if AtomIsChar('>') then
+      break
+    else if CurPos.Flag=cafComma then begin
+      // read next parameter
+    end else
+      RaiseCharExpectedButAtomFound('>');
+  until false;
+  if CreateChildNodes then begin
+    // close list
+    CurNode.EndPos:=CurPos.EndPos;
+    EndChildNode; // end ctnSpecializeParams
+    // close specialize
+    CurNode.EndPos:=CurPos.EndPos;
+    EndChildNode; // end ctnSpecialize
+  end;
+  ReadNextAtom;
+end;
+
 function TPascalParserTool.WordIsPropertyEnd: boolean;
 var
   p: PChar;