From 7f07c32279ae3c7c3777a0903ed0e491b8beb676 Mon Sep 17 00:00:00 2001 From: lazarus Date: Mon, 4 Feb 2002 14:19:18 +0000 Subject: [PATCH] MG: added circle test for find base node git-svn-id: trunk@660 - --- components/codetools/finddeclarationcache.pas | 88 ++++- components/codetools/finddeclarationtool.pas | 348 +++++++++++------- 2 files changed, 291 insertions(+), 145 deletions(-) diff --git a/components/codetools/finddeclarationcache.pas b/components/codetools/finddeclarationcache.pas index 56eb694349..1ba5ee253a 100644 --- a/components/codetools/finddeclarationcache.pas +++ b/components/codetools/finddeclarationcache.pas @@ -113,6 +113,9 @@ type CleanStartPos, CleanEndPos: integer): TAVLTreeNode; function FindNearestAVLNode(Identifier: PChar; CleanStartPos, CleanEndPos: integer; InFront: boolean): TAVLTreeNode; + function FindNearest(Identifier: PChar; + CleanStartPos, CleanEndPos: integer; + InFront: boolean): PCodeTreeNodeCacheEntry; function Find(Identifier: PChar): PCodeTreeNodeCacheEntry; procedure Add(Identifier: PChar; CleanStartPos, CleanEndPos: integer; NewNode: TCodeTreeNode; NewTool: TPascalParserTool; NewCleanPos: integer); @@ -126,7 +129,7 @@ type end; const - // all node types which can create a cache + // all node types which can hold a cache AllNodeCacheDescs = [ctnClass, ctnInterface, ctnInitialization, ctnProgram]; //---------------------------------------------------------------------------- @@ -172,6 +175,27 @@ type function NewNode(AnOwner: TCodeTreeNode): TCodeTreeNodeCache; end; + + //---------------------------------------------------------------------------- + // stacks for circle checking +type + TCodeTreeNodeStackEntry = TCodeTreeNode; + PCodeTreeNodeStackEntry = ^TCodeTreeNodeStackEntry; + + TCodeTreeNodeStack = record + Fixedtems: array[0..9] of TCodeTreeNodeStackEntry; + DynItems: TList; // list of PCodeTreeNodeStackEntry + StackPtr: integer; + end; + PCodeTreeNodeStack = ^TCodeTreeNodeStack; + + procedure InitializeNodeStack(NodeStack: PCodeTreeNodeStack); + procedure AddNodeToStack(NodeStack: PCodeTreeNodeStack; + NewNode: TCodeTreeNode); + function NodeExistsInStack(NodeStack: PCodeTreeNodeStack; + Node: TCodeTreeNode): boolean; + procedure FinalizeNodeStack(NodeStack: PCodeTreeNodeStack); + var GlobalIdentifierTree: TGlobalIdentifierTree; InterfaceIdentCacheEntryMemManager: TInterfaceIdentCacheEntryMemManager; @@ -624,7 +648,7 @@ var begin Result:=FindNearestAVLNode(Identifier,CleanStartPos,CleanEndPos,true); Entry:=PCodeTreeNodeCacheEntry(Result.Data); - if (CleanStartPos>=Entry^.CleanEndPos) + if (CleanStartPos>Entry^.CleanEndPos) or (CleanEndPos=Entry^.CleanEndPos then begin NextNode:=FItems.FindSuccessor(Result); DirectionSucc:=true; - end else if CleanEndPos=Entry^.CleanStartPos) then begin + and (CleanEndPos>Entry^.CleanStartPos) then begin // cached result in range found exit; end; @@ -747,6 +771,17 @@ begin Owner:=NewOwner; end; +function TCodeTreeNodeCache.FindNearest(Identifier: PChar; CleanStartPos, + CleanEndPos: integer; InFront: boolean): PCodeTreeNodeCacheEntry; +var Node: TAVLTreeNode; +begin + Node:=FindNearestAVLNode(Identifier,CleanStartPos,CleanEndPos,InFront); + if Node<>nil then + Result:=PCodeTreeNodeCacheEntry(Node.Data) + else + Result:=nil; +end; + { TNodeCacheMemManager } procedure TNodeCacheMemManager.DisposeNode(Node: TCodeTreeNodeCache); @@ -794,6 +829,51 @@ end; //------------------------------------------------------------------------------ +procedure InitializeNodeStack(NodeStack: PCodeTreeNodeStack); +begin + NodeStack^.StackPtr:=0; + NodeStack^.DynItems:=nil; +end; + +procedure AddNodeToStack(NodeStack: PCodeTreeNodeStack; + NewNode: TCodeTreeNode); +begin + if (NodeStack^.StackPtr<=High(NodeStack^.Fixedtems)) then begin + NodeStack^.Fixedtems[NodeStack^.StackPtr]:=NewNode; + end else begin + if NodeStack^.DynItems=nil then begin + NodeStack^.DynItems:=TList.Create; + end; + NodeStack^.DynItems.Add(NewNode); + end; + inc(NodeStack^.StackPtr); +end; + +function NodeExistsInStack(NodeStack: PCodeTreeNodeStack; + Node: TCodeTreeNode): boolean; +var i: integer; +begin + Result:=true; + i:=0; + while inil) do begin - - // ToDo: check for circles - + InitializeNodeStack(@NodeStack); + try + while (Result.Node<>nil) do begin + if NodeExistsInStack(@NodeStack,Result.Node) then begin + Result.Tool.MoveCursorToNodeStart(Result.Node); + Result.Tool.RaiseException('circle in definitions'); + end; + AddNodeToStack(@NodeStack,Result.Node); {$IFDEF ShowTriedContexts} writeln('[TFindDeclarationTool.FindBaseTypeOfNode] LOOP Result=',Result.Node.DescAsString); {$ENDIF} - if (Result.Node.Desc in AllIdentifierDefinitions) then begin - // instead of variable/const/type definition, return the type - Result.Node:=FindTypeNodeOfDefinition(Result.Node); - end else - if (Result.Node.Desc=ctnClass) - and ((Result.Node.SubDesc and ctnsForwardDeclaration)>0) then - begin - // search the real class - ClassIdentNode:=Result.Node.Parent; - if (ClassIdentNode=nil) or (not (ClassIdentNode.Desc=ctnTypeDefinition)) - then begin - MoveCursorToCleanPos(Result.Node.StartPos); - RaiseException('[TFindDeclarationTool.FindBaseTypeOfNode] ' - +'forward class node without name'); - end; - Params.Save(OldInput); - try - Params.SetIdentifier(Self,@Src[ClassIdentNode.StartPos],@CheckSrcIdentifier); - Params.Flags:=[fdfSearchInParentNodes,fdfSearchForward, - fdfIgnoreUsedUnits,fdfExceptionOnNotFound] - +(fdfGlobals*Params.Flags); - Params.ContextNode:=ClassIdentNode; - FindIdentifierInContext(Params); - if (Params.NewNode.Desc<>ctnTypeDefinition) - or (Params.NewCodeTool<>Self) then begin + if (Result.Node.Desc in AllIdentifierDefinitions) then begin + // instead of variable/const/type definition, return the type + Result.Node:=FindTypeNodeOfDefinition(Result.Node); + end else + if (Result.Node.Desc=ctnClass) + and ((Result.Node.SubDesc and ctnsForwardDeclaration)>0) then + begin + // search the real class + + // ToDo: check for circles in ancestor chain + + + ClassIdentNode:=Result.Node.Parent; + if (ClassIdentNode=nil) or (not (ClassIdentNode.Desc=ctnTypeDefinition)) + then begin MoveCursorToCleanPos(Result.Node.StartPos); - RaiseException('Forward class definition not resolved: ' - +copy(Src,ClassIdentNode.StartPos, - ClassIdentNode.EndPos-ClassIdentNode.StartPos)); + RaiseException('[TFindDeclarationTool.FindBaseTypeOfNode] ' + +'forward class node without name'); end; - Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); - exit; - finally - Params.Load(OldInput); - end; - end else - if (Result.Node.Desc=ctnIdentifier) then begin - // this type is just an alias for another type - // -> search the basic type - if Result.Node.Parent=nil then - break; - Params.Save(OldInput); - try - Params.SetIdentifier(Self,@Src[Result.Node.StartPos],@CheckSrcIdentifier); - Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound] - +(fdfGlobals*Params.Flags) - -[fdfIgnoreUsedUnits]; - IsPredefinedIdentifier:=WordIsPredefinedIdentifier.DoIt( - Params.Identifier); - if IsPredefinedIdentifier then - Exclude(Params.Flags,fdfExceptionOnNotFound); - Params.ContextNode:=Result.Node.Parent; - if Params.ContextNode.Desc=ctnParameterList then - Params.ContextNode:=Params.ContextNode.Parent; - if Params.ContextNode.Desc=ctnProcedureHead then - Params.ContextNode:=Params.ContextNode.Parent; - if FindIdentifierInContext(Params) then - Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode) - else - // predefined identifier - Result:=CreateFindContext(Self,Result.Node); - exit; - finally - Params.Load(OldInput); - end; - end else - if (Result.Node.Desc=ctnProperty) then begin - // this is a property -> search the type definition of the property - ReadTilTypeOfProperty(Result.Node); - Params.Save(OldInput); - try - Params.SetIdentifier(Self,@Src[CurPos.StartPos],@CheckSrcIdentifier); - Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound] - +(fdfGlobals*Params.Flags) - -[fdfIgnoreUsedUnits]; - Params.ContextNode:=Result.Node.Parent; - FindIdentifierInContext(Params); - if Result.Node.HasAsParent(Params.NewNode) then + Params.Save(OldInput); + try + Params.SetIdentifier(Self,@Src[ClassIdentNode.StartPos], + @CheckSrcIdentifier); + Params.Flags:=[fdfSearchInParentNodes,fdfSearchForward, + fdfIgnoreUsedUnits,fdfExceptionOnNotFound] + +(fdfGlobals*Params.Flags); + Params.ContextNode:=ClassIdentNode; + FindIdentifierInContext(Params); + if (Params.NewNode.Desc<>ctnTypeDefinition) + or (Params.NewCodeTool<>Self) then begin + MoveCursorToCleanPos(Result.Node.StartPos); + RaiseException('Forward class definition not resolved: ' + +copy(Src,ClassIdentNode.StartPos, + ClassIdentNode.EndPos-ClassIdentNode.StartPos)); + end; + Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); + exit; + finally + Params.Load(OldInput); + end; + end else + if (Result.Node.Desc=ctnIdentifier) then begin + // this type is just an alias for another type + // -> search the basic type + if Result.Node.Parent=nil then break; - Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); - exit; - finally - Params.Load(OldInput); - end; - end else - if (Result.Node.Desc in [ctnProcedure,ctnProcedureHead]) then begin - // a proc -> if this is a function return the result type - if Result.Node.Desc=ctnProcedureHead then + Params.Save(OldInput); + try + Params.SetIdentifier(Self,@Src[Result.Node.StartPos], + @CheckSrcIdentifier); + Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound] + +(fdfGlobals*Params.Flags) + -[fdfIgnoreUsedUnits]; + IsPredefinedIdentifier:=WordIsPredefinedIdentifier.DoIt( + Params.Identifier); + if IsPredefinedIdentifier then + Exclude(Params.Flags,fdfExceptionOnNotFound); + Params.ContextNode:=Result.Node.Parent; + if Params.ContextNode.Desc=ctnParameterList then + Params.ContextNode:=Params.ContextNode.Parent; + if Params.ContextNode.Desc=ctnProcedureHead then + Params.ContextNode:=Params.ContextNode.Parent; + if FindIdentifierInContext(Params) then + Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode) + else + // predefined identifier + Result:=CreateFindContext(Self,Result.Node); + exit; + finally + Params.Load(OldInput); + end; + end else + if (Result.Node.Desc=ctnProperty) then begin + // this is a property -> search the type definition of the property + ReadTilTypeOfProperty(Result.Node); + Params.Save(OldInput); + try + Params.SetIdentifier(Self,@Src[CurPos.StartPos],@CheckSrcIdentifier); + Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound] + +(fdfGlobals*Params.Flags) + -[fdfIgnoreUsedUnits]; + Params.ContextNode:=Result.Node.Parent; + FindIdentifierInContext(Params); + if Result.Node.HasAsParent(Params.NewNode) then + break; + Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); + exit; + finally + Params.Load(OldInput); + end; + end else + if (Result.Node.Desc in [ctnProcedure,ctnProcedureHead]) then begin + // a proc -> if this is a function return the result type + if Result.Node.Desc=ctnProcedureHead then + Result.Node:=Result.Node.Parent; + MoveCursorToNodeStart(Result.Node); + ReadNextAtom; + if UpAtomIs('CLASS') then ReadNextAtom; + if UpAtomIs('FUNCTION') then begin + // in a function -> find the result type + // build nodes for parameter list and result type + BuildSubTreeForProcHead(Result.Node); + // a proc node contains has as FirstChild a proc-head node + // and a proc-head node has as childs the parameterlist and the result + Result.Node:=Result.Node.FirstChild.FirstChild; + if Result.Node.Desc=ctnParameterList then + Result.Node:=Result.Node.NextBrother; + end else + break; + end else + if (Result.Node.Desc=ctnTypeType) then begin + // a TypeType is for example 'MyInt = type integer;' + // the context is not the 'type' keyword, but the identifier after it. + Result.Node:=Result.Node.FirstChild; + end else + if (Result.Node.Desc=ctnEnumIdentifier) then begin + // an enum identifier, the base type is the enumeration Result.Node:=Result.Node.Parent; - MoveCursorToNodeStart(Result.Node); - ReadNextAtom; - if UpAtomIs('CLASS') then ReadNextAtom; - if UpAtomIs('FUNCTION') then begin - // in a function -> find the result type - // build nodes for parameter list and result type - BuildSubTreeForProcHead(Result.Node); - // a proc node contains has as FirstChild a proc-head node - // and a proc-head node has as childs the parameterlist and the result - Result.Node:=Result.Node.FirstChild.FirstChild; - if Result.Node.Desc=ctnParameterList then - Result.Node:=Result.Node.NextBrother; end else break; - end else - if (Result.Node.Desc=ctnTypeType) then begin - // a TypeType is for example 'MyInt = type integer;' - // the context is not the 'type' keyword, but the identifier after it. - Result.Node:=Result.Node.FirstChild; - end else - if (Result.Node.Desc=ctnEnumIdentifier) then begin - // an enum identifier, the base type is the enumeration - Result.Node:=Result.Node.Parent; - end else - break; - end; - if (Result.Node=nil) and (fdfExceptionOnNotFound in Params.Flags) then begin - if Result.Tool<>nil then begin - - // ToDo ppu, ppw, dcu - - if not Params.IdentifierTool.IsPCharInSrc(Params.Identifier) then - Params.IdentifierTool.RaiseException( - '[TFindDeclarationTool.FindBaseTypeOfNode]' - +' internal error: not IsPCharInSrc(Params.Identifier) ' - +' Params.IdentifierTool.=' - +TCodeBuffer(Params.IdentifierTool.Scanner.MainCode).Filename - +' Ident="'+GetIdentifier(Params.Identifier)+'"'); - Params.IdentifierTool.MoveCursorToCleanPos(Params.Identifier); end; - RaiseException('base type of "'+GetIdentifier(Params.Identifier) - +'" not found'); + if (Result.Node=nil) and (fdfExceptionOnNotFound in Params.Flags) then begin + if Result.Tool<>nil then begin + + // ToDo ppu, ppw, dcu + + if not Params.IdentifierTool.IsPCharInSrc(Params.Identifier) then + Params.IdentifierTool.RaiseException( + '[TFindDeclarationTool.FindBaseTypeOfNode]' + +' internal error: not IsPCharInSrc(Params.Identifier) ' + +' Params.IdentifierTool.=' + +TCodeBuffer(Params.IdentifierTool.Scanner.MainCode).Filename + +' Ident="'+GetIdentifier(Params.Identifier)+'"'); + Params.IdentifierTool.MoveCursorToCleanPos(Params.Identifier); + end; + RaiseException('base type of "'+GetIdentifier(Params.Identifier) + +'" not found'); + end; + finally + FinalizeNodeStack(@NodeStack); end; {$IFDEF CTDEBUG} write('[TFindDeclarationTool.FindBaseTypeOfNode] END Node='); @@ -1740,7 +1796,7 @@ begin Params.ContextNode:=ProcContextNode; Params.SetIdentifier(Self,@Src[ClassNameAtom.StartPos],@CheckSrcIdentifier); {$IFDEF CTDEBUG} -writeln('[TFindDeclarationTool.FindIdentifierInProcContext] Proc="',copy(src,ProcContextNode.StartPos,30),'" searching class of method class="',GetIdentifier(ClassNameAtom.StartPos),'"'); +writeln('[TFindDeclarationTool.FindIdentifierInProcContext] Proc="',copy(src,ProcContextNode.StartPos,30),'" searching class of method class="',ExtractIdentifier(ClassNameAtom.StartPos),'"'); {$ENDIF} FindIdentifierInContext(Params); ClassContext:=Params.NewCodeTool.FindBaseTypeOfNode( @@ -1811,7 +1867,7 @@ writeln('[TFindDeclarationTool.FindClassOfMethod] A '); Params.ContextNode:=ProcNode; Params.SetIdentifier(Self,@Src[ClassNameAtom.StartPos],@CheckSrcIdentifier); {$IFDEF CTDEBUG} -writeln('[TFindDeclarationTool.FindClassOfMethod] searching class of method class="',GetIdentifier(ClassNameAtom.StartPos),'"'); +writeln('[TFindDeclarationTool.FindClassOfMethod] searching class of method class="',ExtractIdentifier(ClassNameAtom.StartPos),'"'); {$ENDIF} FindIdentifierInContext(Params); if FindClassContext then begin @@ -3550,6 +3606,7 @@ begin NewNode:=nil; NewCleanPos:=-1; NewCodeTool:=nil; + NewFlags:=[]; end; procedure TFindDeclarationParams.SetResult(ANewCodeTool: TFindDeclarationTool; @@ -3607,6 +3664,15 @@ begin OnIdentifierFound:=NewOnIdentifierFound; end; +procedure TFindDeclarationParams.SetResult( + NodeCacheEntry: PCodeTreeNodeCacheEntry); +begin + ClearResult; + NewCodeTool:=TFindDeclarationTool(NodeCacheEntry^.NewTool); + NewNode:=NodeCacheEntry^.NewNode; + NewCleanPos:=NodeCacheEntry^.NewCleanPos; +end; + { TExprTypeList }