codetools: improved parsing variable section with errors

git-svn-id: trunk@9894 -

components/codetools/codetoolmanager.pas

@@ -733,6 +733,7 @@ var
   FPCDefines: TDefineTemplate;
   FPCSrcDefines: TDefineTemplate;
   LazarusSrcDefines: TDefineTemplate;
+  ATestPascalFile: String;
 begin
   // set global values
   with GlobalValues do begin
@@ -747,8 +748,11 @@ begin
     FPCUnitPath:=Config.FPCUnitPath;
     TargetOS:=Config.TargetOS;
     TargetProcessor:=Config.TargetProcessor;
+    ATestPascalFile:=Config.TestPascalFile;
+    if ATestPascalFile='' then
+      ATestPascalFile:=GetTempFilename('fpctest.pas','');
     FPCDefines:=CreateFPCTemplate(Config.FPCPath, Config.FPCOptions,
-                          Config.TestPascalFile,
+                          ATestPascalFile,
                           FPCUnitPath, TargetOS, TargetProcessor,
                           nil);
     Add(FPCDefines);

components/codetools/codetree.pas

@@ -189,6 +189,9 @@ const
 
   
 type
+
+  { TCodeTreeNode }
+
   TCodeTreeNode = class
   public
     Desc: TCodeTreeNodeDesc;
@@ -210,6 +213,7 @@ type
     procedure Clear;
     constructor Create;
     function ConsistencyCheck: integer; // 0 = ok
+    procedure WriteDebugReport(const Prefix: string; WithChilds: boolean);
   end;
 
   { TCodeTree }
@@ -228,7 +232,7 @@ type
     constructor Create;
     destructor Destroy; override;
     function ConsistencyCheck: integer; // 0 = ok
-    procedure WriteDebugReport;
+    procedure WriteDebugReport(WithChilds: boolean);
   end;
 
   TCodeTreeNodeExtension = class
@@ -520,6 +524,21 @@ begin
   Result:=0;
 end;
 
+procedure TCodeTreeNode.WriteDebugReport(const Prefix: string;
+  WithChilds: boolean);
+var
+  Node: TCodeTreeNode;
+begin
+  DebugLn([Prefix,DescAsString,' Range=',StartPos,'..',EndPos,' Cache=',DbgSName(Cache)]);
+  if WithChilds then begin
+    Node:=FirstChild;
+    while Node<>nil do begin
+      Node.WriteDebugReport(Prefix+'  ',true);
+      Node:=Node.NextBrother;
+    end;
+  end;
+end;
+
 function TCodeTreeNode.HasAsParent(Node: TCodeTreeNode): boolean;
 var CurNode: TCodeTreeNode;
 begin
@@ -719,10 +738,12 @@ begin
   Result:=0;
 end;
 
-procedure TCodeTree.WriteDebugReport;
+procedure TCodeTree.WriteDebugReport(WithChilds: boolean);
 begin
   DebugLn('[TCodeTree.WriteDebugReport] Consistency=',dbgs(ConsistencyCheck),
     ' Root=',dbgs(Root<>nil));
+  if Root<>nil then
+    Root.WriteDebugReport(' ',true);
 end;
 
 { TCodeTreeNodeExtension }

components/codetools/customcodetool.pas

@@ -37,6 +37,7 @@ interface
 
 { $DEFINE ShowIgnoreError}
 {$DEFINE ShowDirtySrc}
+{ $DEFINE VerboseUpdateNeeded}
 
 uses
   {$IFDEF MEM_CHECK}
@@ -176,7 +177,7 @@ type
     function MainFilename: string;
     
     function FindDeepestNodeAtPos(P: integer;
-      ExceptionOnNotFound: boolean): TCodeTreeNode;
+      ExceptionOnNotFound: boolean): TCodeTreeNode; inline;
     function FindDeepestNodeAtPos(StartNode: TCodeTreeNode; P: integer;
       ExceptionOnNotFound: boolean): TCodeTreeNode;
     function CaretToCleanPos(Caret: TCodeXYPosition;
@@ -458,6 +459,9 @@ begin
     FLastScannerChangeStep:=Scanner.ChangeStep;
     Scanner.SetIgnoreErrorAfter(IgnoreErrorAfter.P,IgnoreErrorAfter.Code);
   end;
+  {$IFDEF VerboseUpdateNeeded}
+  DebugLn(['TCustomCodeTool.SetScanner FForceUpdateNeeded:=true ',MainFilename]);
+  {$ENDIF}
   FForceUpdateNeeded:=true;
 end;
 
@@ -1612,6 +1616,9 @@ begin
       Src:=Scanner.CleanedSrc;
       UpperSrc:=UpperCaseStr(Src);
       SrcLen:=length(Src);
+      {$IFDEF VerboseUpdateNeeded}
+      DebugLn(['TCustomCodeTool.BeginParsing FForceUpdateNeeded:=true ',MainFilename]);
+      {$ENDIF}
       FForceUpdateNeeded:=true;
       DirtySrc.Free;
       DirtySrc:=nil;
@@ -2007,7 +2014,8 @@ var
   ChildNode: TCodeTreeNode;
   Brother: TCodeTreeNode;
 begin
-  if StartNode<>nil then begin
+  Result:=nil;
+  while StartNode<>nil do begin
 //DebugLn('SearchInNode ',NodeDescriptionAsString(ANode.Desc),
 //',',ANode.StartPos,',',ANode.EndPos,', p=',p,
 //' "',copy(Src,ANode.StartPos,4),'" - "',copy(Src,ANode.EndPos-5,4),'"');
@@ -2029,11 +2037,12 @@ begin
         end;
         Brother:=Brother.NextBrother;
       end;
-    end else
+      break;
+    end else begin
       // search in next node
-      Result:=FindDeepestNodeAtPos(StartNode.NextBrother,P,false);
+      StartNode:=StartNode.NextBrother;
-  end else
+    end;
-    Result:=nil;
+  end;
   if (Result=nil) and ExceptionOnNotFound then begin
     MoveCursorToCleanPos(P);
     RaiseNoNodeFoundAtCursor;
@@ -2266,6 +2275,9 @@ begin
     exit;
   end;
   if (FLastScannerChangeStep<>Scanner.ChangeStep) then begin
+    {$IFDEF VerboseUpdateNeeded}
+    DebugLn(['TCustomCodeTool.UpdateNeeded because FLastScannerChangeStep<>Scanner.ChangeStep ',MainFilename]);
+    {$ENDIF}
     Result:=true;
   end else begin
     if OnlyInterfaceNeeded then
@@ -2273,6 +2285,10 @@ begin
     else
       LinkScanRange:=lsrEnd;
     Result:=Scanner.UpdateNeeded(LinkScanRange, CheckFilesOnDisk);
+    {$IFDEF VerboseUpdateNeeded}
+    if Result then
+      DebugLn(['TCustomCodeTool.UpdateNeeded because Scanner.UpdateNeeded ',MainFilename]);
+    {$ENDIF}
   end;
   FForceUpdateNeeded:=Result;
   {$IFDEF CTDEBUG}

components/codetools/definetemplates.pas

@@ -2741,8 +2741,11 @@ var CmdLine: string;
   SrcOS2: String;
   Step: String;
 begin
-  //DebugLn('TDefinePool.CreateFPCTemplate PPC386Path="',CompilerPath,'" PPCOptions="',CompilerOptions,'"');
   Result:=nil;
+  //DebugLn('TDefinePool.CreateFPCTemplate PPC386Path="',CompilerPath,'" PPCOptions="',CompilerOptions,'"');
+  if TestPascalFile='' then begin
+    DebugLn(['WARNING: TDefinePool.CreateFPCTemplate TestPascalFile empty']);
+  end;
   UnitSearchPath:='';
   TargetOS:='';
   SrcOS:='';
@@ -3341,8 +3344,14 @@ begin
   {$IFDEF VerboseFPCSrcScan}
   DebugLn('CreateFPCSrcTemplate ',FPCSrcDir,': length(UnitSearchPath)=',DbgS(length(UnitSearchPath)),' Valid=',DbgS(UnitLinkListValid),' PPUExt=',PPUExt);
   {$ENDIF}
+  if UnitSearchPath='' then begin
+    DebugLn(['Note: TDefinePool.CreateFPCSrcTemplate UnitSearchPath empty']);
+  end;
   Result:=nil;
-  if (FPCSrcDir='') or (not DirPathExists(FPCSrcDir)) then exit;
+  if (FPCSrcDir='') or (not DirPathExists(FPCSrcDir)) then begin
+    DebugLn(['TDefinePool.CreateFPCSrcTemplate FPCSrcDir does not exist: FPCSrcDir="',FPCSrcDir,'"']);
+    exit;
+  end;
   DS:=PathDelim;
   Dir:=AppendPathDelim(FPCSrcDir);
   TargetOS:='$('+ExternalMacroStart+'TargetOS)';

components/codetools/identcompletiontool.pas

@@ -743,6 +743,7 @@ begin
   Result:=ifrProceedSearch;
 
   {$IFDEF ShowFoundIdents}
+  if FoundContext.Tool=Self then
   DebugLn('::: COLLECT IDENT ',FoundContext.Node.DescAsString,
     ' "',StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)),'"'
     ,' '+dbgs(fdfIgnoreUsedUnits in Params.Flags));
@@ -1255,7 +1256,7 @@ begin
     InitCollectIdentifiers(CursorPos,IdentifierList);
     ParseSourceTillCollectionStart(CursorPos,CleanCursorPos,CursorNode,
                                    IdentStartPos,IdentEndPos);
-    
+
     // find context
     {$IFDEF CTDEBUG}
     DebugLn('TIdentCompletionTool.GatherIdentifiers B',
@@ -1289,7 +1290,6 @@ begin
         Params.Flags:=[fdfSearchInAncestors,fdfCollect,fdfFindVariable];
         if not StartInSubContext then
           Include(Params.Flags,fdfSearchInParentNodes);
-
         if Params.ContextNode.Desc in [ctnClass,ctnClassInterface] then
           Exclude(Params.Flags,fdfSearchInParentNodes);
         {$IFDEF CTDEBUG}

components/codetools/pascalparsertool.pas

@@ -544,6 +544,7 @@ begin
     if (not IgnoreErrorAfterValid)
     or (not IgnoreErrorAfterPositionIsInFrontOfLastErrMessage) then
       raise;
+    FForceUpdateNeeded:=false;
     {$IFDEF ShowIgnoreErrorAfter}
     DebugLn('TPascalParserTool.BuildTree ',MainFilename,' IGNORING ERROR: ',LastErrorMessage);
     {$ENDIF}
@@ -2628,6 +2629,8 @@ function TPascalParserTool.KeyWordFuncVar: boolean;
     var d:e;
       f:g=h;
 }
+var
+  LastIdentifierEnd: LongInt;
 begin
   if not (CurSection in [ctnProgram,ctnLibrary,ctnInterface,ctnImplementation])
   then
@@ -2640,15 +2643,16 @@ begin
     if AtomIsIdentifier(false) then begin
       CreateChildNode;
       CurNode.Desc:=ctnVarDefinition;
-      CurNode.EndPos:=CurPos.EndPos;
+      LastIdentifierEnd:=CurPos.EndPos;
       ReadNextAtom;
       while (CurPos.Flag=cafComma) do begin
+        CurNode.EndPos:=LastIdentifierEnd;
         EndChildNode; // close variable definition
         ReadNextAtom;
         AtomIsIdentifier(true);
         CreateChildNode;
         CurNode.Desc:=ctnVarDefinition;
-        CurNode.EndPos:=CurPos.EndPos;
+        LastIdentifierEnd:=CurPos.EndPos;
         ReadNextAtom;
       end;
       if (CurPos.Flag<>cafColon) then begin
@@ -3759,6 +3763,7 @@ var
   CaretType: integer;
   IgnorePos: TCodePosition;
 begin
+  //DebugLn(['TPascalParserTool.BuildTreeAndGetCleanPos ',MainFilename,' btSetIgnoreErrorPos=',btSetIgnoreErrorPos in BuildTreeFlags,' btKeepIgnoreErrorPos=',btKeepIgnoreErrorPos in BuildTreeFlags,' CursorPos=x=',CursorPos.X,',y=',CursorPos.Y]);
   if (btSetIgnoreErrorPos in BuildTreeFlags) then begin
     // ignore errors after cursor position
     if (CursorPos.Code<>nil) then begin