diff --git a/components/codetools/codetoolsstrconsts.pas b/components/codetools/codetoolsstrconsts.pas index 8e32b333aa..6304878d68 100644 --- a/components/codetools/codetoolsstrconsts.pas +++ b/components/codetools/codetoolsstrconsts.pas @@ -102,6 +102,7 @@ ResourceString 'inherited keyword only allowed in methods'; ctsCircleInDefinitions = 'circle in definitions'; ctsForwardClassDefinitionNotResolved = 'Forward class definition not resolved: %s'; + ctsClassOfDefinitionNotResolved = '"class of" definition not resolved: %s'; ctsTypeIdentifier = 'type identifier'; ctsAncestorIsNotProperty = 'ancestor of untyped property is not a property'; ctsBaseTypeOfNotFound = 'base type of "%s" not found'; diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 71aea3ed6a..b1427359e6 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -2324,6 +2324,12 @@ function TFindDeclarationTool.FindBaseTypeOfNode(Params: TFindDeclarationParams; RaiseExceptionFmt(ctsBaseTypeOfNotFound,[GetIdentifier(Params.Identifier)]); end; + procedure RaiseClassOfWithoutIdentifier; + begin + RaiseExceptionFmt(ctsBaseTypeOfNotFound+' ("class of")', + [GetIdentifier(Params.Identifier)]); + end; + var OldInput: TFindDeclarationInput; ClassIdentNode, DummyNode: TCodeTreeNode; @@ -2338,6 +2344,14 @@ var ClassIdentNode.EndPos-ClassIdentNode.StartPos)]); end; + procedure RaiseClassOfNotResolved; + begin + MoveCursorToNodeStart(ClassIdentNode); + RaiseExceptionFmt(ctsClassOfDefinitionNotResolved, + [copy(Src,ClassIdentNode.StartPos, + ClassIdentNode.EndPos-ClassIdentNode.StartPos)]); + end; + begin Result.Node:=Node; Result.Tool:=Self; @@ -2405,6 +2419,38 @@ begin Params.Load(OldInput); exit; end else + if (Result.Node.Desc=ctnClassOfType) then + begin + // this is a 'class of' type + // -> search the real class + {$IFDEF ShowTriedBaseContexts} + writeln('[TFindDeclarationTool.FindBaseTypeOfNode] "Class Of"'); + {$ENDIF} + + // ToDo: check for circles in ancestor chain + + ClassIdentNode:=Result.Node.FirstChild; + if (ClassIdentNode=nil) or (not (ClassIdentNode.Desc=ctnIdentifier)) + then begin + MoveCursorToCleanPos(Result.Node.StartPos); + RaiseClassOfWithoutIdentifier; + end; + Params.Save(OldInput); + Params.SetIdentifier(Self,@Src[ClassIdentNode.StartPos], + @CheckSrcIdentifier); + Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound, + fdfIgnoreCurContextNode] + +(fdfGlobals*Params.Flags); + Params.ContextNode:=Result.Node.Parent; + FindIdentifierInContext(Params); + if (Params.NewNode.Desc<>ctnTypeDefinition) then begin + MoveCursorToCleanPos(Result.Node.StartPos); + RaiseClassOfNotResolved; + end; + Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); + Params.Load(OldInput); + exit; + end else if (Result.Node.Desc=ctnIdentifier) then begin // this type is just an alias for another type // -> search the basic type diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index a8b73ebf92..bc78b6cd76 100644 --- a/components/codetools/pascalparsertool.pas +++ b/components/codetools/pascalparsertool.pas @@ -2551,18 +2551,25 @@ begin // find end of class ReadNextAtom; if UpAtomIs('OF') then begin + if ChildCreated then CurNode.Desc:=ctnClassOfType; ReadNextAtom; AtomIsIdentifier(true); + if ChildCreated then begin + CreateChildNode; + CurNode.Desc:=ctnIdentifier; + CurNode.EndPos:=CurPos.EndPos; + EndChildNode; + end; ReadNextAtom; if CurPos.Flag<>cafSemicolon then RaiseCharExpectedButAtomFound(';'); - if ChildCreated then CurNode.Desc:=ctnClassOfType; end else if (CurPos.Flag=cafRoundBracketOpen) then begin // read inheritage brackets ReadTilBracketClose(true); ReadNextAtom; end; - CurNode.SubDesc:=ctnsNeedJITParsing; // will not create sub nodes now + if ChildCreated and (CurNode.Desc=ctnClass) then + CurNode.SubDesc:=ctnsNeedJITParsing; // will not create sub nodes now if CurPos.Flag=cafSemicolon then begin if ChildCreated and (CurNode.Desc=ctnClass) then begin // forward class definition found