MG: fixed node cache dependency update bug

git-svn-id: trunk@1603 -

components/codetools/codecompletiontool.pas

@@ -43,7 +43,7 @@ interface
 
 {$I codetools.inc}
 
-{ $DEFINE CTDEBUG}
+{$DEFINE CTDEBUG}
 
 uses
   {$IFDEF MEM_CHECK}
@@ -177,6 +177,7 @@ begin
       TrimmedIdentifier:=GetIdentifier(Params.Identifier);
     end;
   end;
+  //writeln('RRR ',TrimmedIdentifier);
   FullTopLvlName:=FullTopLvlName+TrimmedIdentifier;
   Result:=ifrSuccess;
 end;

components/codetools/finddeclarationtool.pas

@@ -62,6 +62,7 @@ interface
 { $DEFINE ShowInterfaceCache}
 { $DEFINE ShowNodeCache}
 { $DEFINE ShowBaseTypeCache}
+{ $DEFINE ShowCacheDependencies}
 
 uses
   {$IFDEF MEM_CHECK}
@@ -394,6 +395,7 @@ type
     function GetFirstParameterNode(Node: TCodeTreeNode): TCodeTreeNode;
     function PredefinedIdentToTypeDesc(Identifier: PChar): TExpressionTypeDesc;
   public
+    procedure BuildTree(OnlyInterfaceNeeded: boolean); override;
     destructor Destroy; override;
     function FindDeclaration(CursorPos: TCodeXYPosition;
       var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
@@ -574,7 +576,6 @@ begin
     {$IFDEF CTDEBUG}
     writeln(DebugPrefix,'TFindDeclarationTool.FindDeclaration A CursorPos=',CursorPos.X,',',CursorPos.Y);
     {$ENDIF}
-    CheckDependsOnNodeCaches;
     BuildTreeAndGetCleanPos(false,CursorPos,CleanCursorPos);
     {$IFDEF CTDEBUG}
     writeln(DebugPrefix,'TFindDeclarationTool.FindDeclaration C CleanCursorPos=',CleanCursorPos);
@@ -1104,7 +1105,8 @@ var
     FindIdentifierInContext:=NewResult;
     Result:=NewResult;
     if NewResult then begin
-      if CallOnIdentifierFound then DoOnIdentifierFound(Params,ContextNode);
+      if CallOnIdentifierFound then
+        Params.NewCodeTool.DoOnIdentifierFound(Params,Params.NewNode);
       exit;
     end;
     if not (fdfExceptionOnNotFound in Params.Flags) then exit;
@@ -1409,7 +1411,7 @@ begin
       if not (fdfIgnoreCurContextNode in Params.Flags) then begin
         // search in cache
         if FindInNodeCache then begin
-          SetResultBeforeExit(Params.NewNode<>nil,true);
+          SetResultBeforeExit(Params.NewNode<>nil,Params.NewNode<>nil);
           exit;
         end;
         if FirstSearchedNode=nil then FirstSearchedNode:=ContextNode;
@@ -3021,6 +3023,8 @@ begin
   
   // build tree for pascal source
   BuildTree(true);
+  if (AskingTool<>Self) and (AskingTool<>nil) then
+    AskingTool.AddToolDependency(Self);
 
   // search identifier in cache
   if FInterfaceIdentifierCache<>nil then begin
@@ -3161,7 +3165,6 @@ begin
     Params.Flags:=[fdfIgnoreUsedUnits]+(fdfGlobalsSameIdent*Params.Flags)
                  -[fdfExceptionOnNotFound];
     Result:=NewCodeTool.FindIdentifierInInterface(Self,Params);
-    AddToolDependency(NewCodeTool);
     if Result then
       // do not reload param input, so that find next is possible
       exit
@@ -3185,6 +3188,12 @@ begin
   end;
 end;
 
+procedure TFindDeclarationTool.BuildTree(OnlyInterfaceNeeded: boolean);
+begin
+  CheckDependsOnNodeCaches;
+  inherited BuildTree(OnlyInterfaceNeeded);
+end;
+
 function TFindDeclarationTool.FindIdentifierInHiddenUsedUnits(
   Params: TFindDeclarationParams): boolean;
 const
@@ -3631,7 +3640,9 @@ begin
     if (Result.Desc=ctnProperty) then
       Result:=Result.FirstChild
     else if Result.Desc in [ctnProcedure,ctnProcedureHead] then begin
+writeln('AAA3');
       BuildSubTreeForProcHead(Result);
+writeln('AAA4');
       if Result.Desc=ctnProcedure then
         Result:=Result.FirstChild;
       if Result.Desc=ctnProcedureHead then
@@ -3643,7 +3654,9 @@ end;
 function TFindDeclarationTool.GetFirstParameterNode(Node: TCodeTreeNode
   ): TCodeTreeNode;
 begin
+writeln('AAA1');
   Result:=GetParameterNode(Node);
+writeln('AAA2');
   if Result<>nil then Result:=Result.FirstChild;
 end;
 
@@ -3651,7 +3664,7 @@ function TFindDeclarationTool.CheckSrcIdentifier(
   Params: TFindDeclarationParams;
   FoundContext: TFindContext): TIdentifierFoundResult;
 // this is a TOnIdentifierFound function
-//   if identifier is founda proc it searches for the best overloaded proc
+//   if identifier found is a proc it searches for the best overloaded proc
 var FirstParameterNode: TCodeTreeNode;
   ExprInputList: TExprTypeList;
   ParamCompatibility, NewComp: TTypeCompatibility;
@@ -3663,6 +3676,7 @@ begin
   // the search has found an identifier with the right name
   {$IFDEF ShowFoundIdentifier}
   writeln('[TFindDeclarationTool.CheckSrcIdentifier]',
+  ' Indent=',GetIdentifier(Params.Identifier),
   ' FoundContext=',FoundContext.Node.DescAsString
   );
   {$ENDIF}
@@ -3702,14 +3716,18 @@ begin
         end;
         try
           // check the first proc for compatibility
+  writeln('[TFindDeclarationTool.CheckSrcIdentifier] A');
           CurFoundContext:=FoundContext;
+  writeln('[TFindDeclarationTool.CheckSrcIdentifier] B ',FoundContext.Tool.MainFilename);
           FirstParameterNode:=FoundContext.Tool.GetFirstParameterNode(
             FoundContext.Node);
+  writeln('[TFindDeclarationTool.CheckSrcIdentifier] C');
           ParamCompatibility:=FoundContext.Tool.IsParamListCompatible(
             FirstParameterNode,
             ExprInputList,fdfIgnoreMissingParams in Params.Flags,
             Params,BestCompatibilityList);
           FoundContext:=CurFoundContext;
+  writeln('[TFindDeclarationTool.CheckSrcIdentifier] D');
           if ParamCompatibility=tcExact then begin
             // the first proc fits exactly -> stop the search
             Result:=ifrSuccess;
@@ -3721,6 +3739,7 @@ begin
           Include(Params.Flags,fdfFirstIdentFound);
           Params.SetResult(FoundContext);
           Params.ContextNode:=FoundContext.Node;
+  writeln('[TFindDeclarationTool.CheckSrcIdentifier] E');
           repeat
             {$IFDEF ShowFoundIdentifier}
             writeln('[TFindDeclarationTool.CheckSrcIdentifier] Search next overloaded proc ',
@@ -4165,6 +4184,7 @@ var
   GlobalWriteLockIsSet: boolean;
   GlobalWriteLockStep: integer;
 begin
+  Result:=false;
   if Assigned(OnGetGlobalWriteLockInfo) then begin
     OnGetGlobalWriteLockInfo(GlobalWriteLockIsSet,GlobalWriteLockStep);
     if GlobalWriteLockIsSet then begin
@@ -4174,7 +4194,6 @@ begin
       if (FLastNodeCachesGlobalWriteLockStep=GlobalWriteLockStep) then begin
         // source and values did not change since last NodeCache check
         Result:=true;
-        exit;
       end else begin
         // this is the first check in this GlobalWriteLockStep
         FLastNodeCachesGlobalWriteLockStep:=GlobalWriteLockStep;
@@ -4182,7 +4201,9 @@ begin
       end;
     end;
   end;
-  Result:=false;
+  {$IFDEF ShowCacheDependencies}
+  writeln('[TFindDeclarationTool.NodeCacheGlobalWriteLockStepDidNotChange] Result=',Result,' ',MainFilename);
+  {$ENDIF}
 end;
 
 function TFindDeclarationTool.CheckDependsOnNodeCaches: boolean;
@@ -4196,6 +4217,9 @@ begin
   then exit;
 
   FCheckingNodeCacheDependencies:=true;
+  {$IFDEF ShowCacheDependencies}
+  writeln('[TFindDeclarationTool.CheckDependsOnNodeCaches] START ',MainFilename);
+  {$ENDIF}
   try
     ANode:=FDependsOnCodeTools.FindLowest;
     while ANode<>nil do begin
@@ -4206,6 +4230,9 @@ begin
     end;
     Result:=UpdateNeeded(Scanner.ScanTillInterfaceEnd);
   finally
+    {$IFDEF ShowCacheDependencies}
+    writeln('[TFindDeclarationTool.CheckDependsOnNodeCaches] Result=',Result,' ',MainFilename);
+    {$ENDIF}
     FCheckingNodeCacheDependencies:=false;
     if Result then ClearNodeCaches(true);
   end;
@@ -4229,8 +4256,13 @@ var
 begin
   // check if there is something in cache to delete
   if (FFirstNodeCache=nil) and (FFirstBaseTypeCache=nil)
-  and (FRootNodeCache=nil) then
+  and (FRootNodeCache=nil)
+  and ((FDependentCodeTools=nil) or (FDependentCodeTools.Count=0))
+  and ((FDependsOnCodeTools=nil) or (FDependsOnCodeTools.Count=0)) then
     exit;
+  {$IFDEF ShowCacheDependencies}
+  writeln('[TFindDeclarationTool.ClearNodeCaches] Force=',Force,' ',MainFilename);
+  {$ENDIF}
     
   // quick check: check if in the same GlobalWriteLockStep
   if (not Force) and NodeCacheGlobalWriteLockStepDidNotChange then
@@ -4260,16 +4292,18 @@ end;
 procedure TFindDeclarationTool.ClearDependentNodeCaches;
 var
   ANode: TAVLTreeNode;
-  ATool: TFindDeclarationTool;
+  DependentTool: TFindDeclarationTool;
 begin
   if (FDependentCodeTools=nil) or FClearingDependentNodeCaches then exit;
   FClearingDependentNodeCaches:=true;
+  {$IFDEF ShowCacheDependencies}
+  writeln('[TFindDeclarationTool.ClearDependentNodeCaches] ',MainFilename);
+  {$ENDIF}
   try
     ANode:=FDependentCodeTools.FindLowest;
     while ANode<>nil do begin
-      ATool:=TFindDeclarationTool(ANode.Data);
+      DependentTool:=TFindDeclarationTool(ANode.Data);
-      ATool.ClearNodeCaches(true);
+      DependentTool.ClearNodeCaches(true);
-      FDependsOnCodeTools.Remove(ATool);
       ANode:=FDependentCodeTools.FindSuccessor(ANode);
     end;
     FDependentCodeTools.Clear;
@@ -4281,14 +4315,17 @@ end;
 procedure TFindDeclarationTool.ClearDependsOnToolRelationships;
 var
   ANode: TAVLTreeNode;
-  ATool: TFindDeclarationTool;
+  DependOnTool: TFindDeclarationTool;
 begin
   if FDependsOnCodeTools=nil then exit;
+  {$IFDEF ShowCacheDependencies}
+  writeln('[TFindDeclarationTool.ClearDependsOnToolRelationships] ',MainFilename);
+  {$ENDIF}
   ANode:=FDependsOnCodeTools.FindLowest;
   while ANode<>nil do begin
-    ATool:=TFindDeclarationTool(ANode.Data);
+    DependOnTool:=TFindDeclarationTool(ANode.Data);
-    if not ATool.FClearingDependentNodeCaches then
+    if not DependOnTool.FClearingDependentNodeCaches then
-      ATool.FDependentCodeTools.Remove(Self);
+      DependOnTool.FDependentCodeTools.Remove(Self);
     ANode:=FDependsOnCodeTools.FindSuccessor(ANode);
   end;
   FDependsOnCodeTools.Clear;
@@ -4296,17 +4333,19 @@ end;
 
 procedure TFindDeclarationTool.AddToolDependency(
   DependOnTool: TFindDeclarationTool);
-// this tool depends on DependOnTool
+// build a relationship: this tool depends on DependOnTool
 begin
+  {$IFDEF ShowCacheDependencies}
+  writeln('[TFindDeclarationTool.AddToolDependency] "',MainFilename,'" depends on "',DependOnTool.MainFilename,'"');
+  {$ENDIF}
   if DependOnTool.FDependentCodeTools=nil then
     DependOnTool.FDependentCodeTools:=TAVLTree.Create;
   if DependOnTool.FDependentCodeTools.Find(Self)=nil then
     DependOnTool.FDependentCodeTools.Add(Self);
   if FDependsOnCodeTools=nil then
     FDependsOnCodeTools:=TAVLTree.Create;
-  if FDependsOnCodeTools.Find(DependOnTool)=nil then begin
+  if FDependsOnCodeTools.Find(DependOnTool)=nil then
     FDependsOnCodeTools.Add(DependOnTool);
-  end;
 end;
 
 function TFindDeclarationTool.ConsistencyCheck: integer;
@@ -4411,8 +4450,7 @@ begin
       CleanEndPos:=SrcLen+1;
   end;
   {$IFDEF ShowNodeCache}
-  beVerbose:=CompareSrcIdentifiers(Identifier,'ReadParamType')
+  beVerbose:=CompareSrcIdentifiers(Identifier,'FONT');
-            and (ExtractFileName(MainFilename)='pascalparsertool.pas');
   if beVerbose then begin
     writeln('(((((((((((((((((((((((((((==================');
     

components/codetools/pascalparsertool.pas

@@ -1584,7 +1584,7 @@ begin
       ctnFinalization,ctnProgram])
     then begin
       ReadNextAtom;
-      SaveRaiseException(ctsUnexpectedEndOfSource);
+      SaveRaiseException(ctsUnexpectedEndOfSource+' 1');
     end;
   end else if UpAtomIs('END') then begin
     if LastAtomIs(0,'@') then
@@ -3600,22 +3600,26 @@ begin
   CurrentPhase:=CodeToolPhaseParse;
   try
     if ProcNode.Desc=ctnProcedureHead then ProcNode:=ProcNode.Parent;
+writeln('BBB1');
     if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure)
     or (ProcNode.FirstChild=nil) then
       SaveRaiseException('[TPascalParserTool.BuildSubTreeForProcHead] '
         +'internal error: invalid ProcNode');
+writeln('BBB2');
     if (ProcNode.FirstChild.SubDesc and ctnsNeedJITParsing)=0 then exit;
     IsMethod:=ProcNode.HasParentOfType(ctnClass);
     MoveCursorToNodeStart(ProcNode);
     ReadNextAtom;
     if UpAtomIs('CLASS') then
       ReadNextAtom;
+writeln('BBB3 ',GetAtom);
     IsFunction:=UpAtomIs('FUNCTION');
     IsOperator:=UpAtomIs('OPERATOR');
     // read procedure head (= name + parameterlist + resulttype;)
     CurNode:=ProcNode.FirstChild;
     ReadNextAtom;// read first atom of head
-    if not IsOperator then AtomIsIdentifier(true);
+writeln('BBB4 ',GetAtom);
+    if IsOperator then AtomIsIdentifier(true);
     ReadNextAtom;
     if AtomIsChar('.') then begin
       // read procedure name of a class method (the name after the . )
@@ -3623,13 +3627,16 @@ begin
       AtomIsIdentifier(true);
       ReadNextAtom;
     end;
+writeln('BBB5');
     // read rest of procedure head and build nodes
     HasForwardModifier:=false;
     ParseAttr:=[pphCreateNodes];
     if IsMethod then Include(ParseAttr,pphIsMethod);
     if IsFunction then Include(ParseAttr,pphIsFunction);
     if IsOperator then Include(ParseAttr,pphIsOperator);
+writeln('BBB6');
     ReadTilProcedureHeadEnd(ParseAttr,HasForwardModifier);
+writeln('BBB7');
     ProcNode.FirstChild.SubDesc:=ctnsNone;
   finally
     CurrentPhase:=OldPhase;