diff --git a/components/codetools/codetree.pas b/components/codetools/codetree.pas index 910af13f94..bd891938e6 100644 --- a/components/codetools/codetree.pas +++ b/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'; diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 6099c42380..0a92d7f6be 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/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) diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index 63d0725b28..06ab7d09aa 100644 --- a/components/codetools/pascalparsertool.pas +++ b/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