Codetools: Tests, check the node tree for consistency.

components/codetools/tests/laztests/bug32252.pas

@@ -1,4 +1,4 @@
-program bug32252;
+program bug32252;{%skipnodechecks}
 {$MODE DELPHI}
 {$MACRO ON}
 {$DEFINE CUSTOM_DICTIONARY_CONSTRAINTS := TKey, TValue, THashFactory}

components/codetools/tests/laztests/bug40145.pas

@@ -1,4 +1,4 @@
-unit bug40145;
+unit bug40145;{%skipnodechecks}
 
 {$mode delphi}{$H+}
 

components/codetools/tests/moduletests/fdt_generics_finddeclaration.pas

@@ -1,7 +1,7 @@
 {
   ./testcodetools --format=plain --suite=TestFindDeclaration_Generics_FindDeclaration
 }
-program fdt_generics_finddeclaration;
+program fdt_generics_finddeclaration;{%skipnodechecks}
 
 {$mode objfpc}{$H+}
 

components/codetools/tests/moduletests/fdt_generics_guesstype.pas

@@ -1,7 +1,7 @@
 {
   ./testcodetools --format=plain --suite=TestFindDeclaration_Generics_GuessType
 }
-program fdt_generics_guesstype;
+program fdt_generics_guesstype;{%skipnodechecks}
 
 {$mode objfpc}{$H+}
 

components/codetools/tests/moduletests/fdt_generics_guesstype2.pas

@@ -1,7 +1,7 @@
 {
   ./testcodetools --format=plain --suite=TestFindDeclaration_Generics_GuessType2
 }
-program fdt_generics_guesstype2;
+program fdt_generics_guesstype2;{%skipnodechecks}
 
 {$mode objfpc}{$H+}
 

components/codetools/tests/testfinddeclaration.pas

@@ -476,7 +476,8 @@ var
     ExpectedCompletionPart, ExpectedTermPart, ExpectedTermPartEx, s: String;
   k:char;
   IdentItem: TIdentifierListItem;
-  ItsAKeyword, IsSubIdentifier, ExpInvert, ExpComment, InvMarker, ExactMarker: boolean;
+  ItsAKeyword, IsSubIdentifier, ExpInvert, ExpComment, InvMarker, ExactMarker,
+    DoCheckNode: boolean;
   ExistingDefinition: TFindContext;
   ListOfPFindContext: TFPList;
   NewExprType: TExpressionType;
@@ -485,6 +486,8 @@ var
 begin
   FMainCode:=aCode;
   DoParseModule(MainCode,FMainTool);
+  DoCheckNode := pos('{%skipnodechecks}', FMainTool.Src) < 1;
+  if DoCheckNode then CheckNodeTree('StartA: '+FMainTool.Scanner.MainFilename, FMainTool, Self);
   Src:=MainTool.Src;
   FMarkers.Clear;
 
@@ -798,7 +801,9 @@ begin
       until CommentP >= CommentEnd;
     end;
   end;
+  if DoCheckNode then CheckNodeTree('EndA: '+FMainTool.Scanner.MainFilename, FMainTool, Self);
   CheckReferenceMarkers;
+  if DoCheckNode then CheckNodeTree('EndB: '+FMainTool.Scanner.MainFilename, FMainTool, Self);
   CodeToolBoss.IdentComplIncludeKeywords := False;
 end;
 
@@ -1840,7 +1845,7 @@ procedure TTestFindDeclaration.TestFindDeclaration_VarArgsOfType;
 begin
   StartProgram;
   Add([
-  'procedure Run; varargs of word;',
+  'procedure Run; varargs of word;{%skipnodechecks}',  // TODO: VarArgs node ends with -1
   'begin',
   '  Run{declaration:run}(1,2);',
   'end;',

components/codetools/tests/testpascalparser.pas

@@ -74,8 +74,84 @@ type
     procedure TestVarWithClassOf;
   end;
 
+procedure CheckNodeTree(Name: String; Tool: TCodeTool; Test: TTestCase; UnfinishedSource: boolean = False);
+
 implementation
 
+procedure CheckNodeTree(Name: String; Tool: TCodeTool; Test: TTestCase; UnfinishedSource: boolean);
+
+  function NodeToPathName(Node: TCodeTreeNode): String;
+  var
+    n: TCodeTreeNode;
+    i: Integer;
+  begin
+    if Node = Nil then exit(Name);
+    Result := NodeToPathName(Node.Parent);
+    n := Node;
+    i := 0;
+    while n <> nil do begin
+      inc(i);
+      n := n.PriorBrother;
+    end;
+    Result := Format('%s/%d:%s(%d..%d)', [Result, i, NodeDescriptionAsString(Node.Desc), Node.StartPos, Node.EndPos]);
+  end;
+
+  function CheckNode(Node: TCodeTreeNode; MinPos, MaxPos: integer; ParentIsLastSibling: boolean
+    ): TCodeTreeNode;
+  var
+    BrotherEnd: Integer;
+    LastChildNode: TCodeTreeNode;
+  begin
+    Result := nil;
+    if Node = Nil then
+      exit;
+
+    if Node.EndPos > 0 then
+      ParentIsLastSibling := False;
+
+    if Node.PriorBrother <> nil then
+      Test.Fail('FirstChild Node has prior brother: '+NodeToPathName(Node));
+
+    BrotherEnd := 0;
+    repeat
+      if Node.StartPos < MinPos then
+        Test.Fail('Node starts before parent start: '+NodeToPathName(Node));
+      if Node.StartPos < BrotherEnd then
+        Test.Fail('Node starts before prior brother end: '+NodeToPathName(Node));
+      if Node.StartPos > MaxPos then Test.Fail('Node starts after parent end: '+NodeToPathName(Node));
+
+      if not(UnfinishedSource and ParentIsLastSibling and (Node.EndPos=-1)) then
+        if Node.EndPos < MinPos then
+          Test.Fail('Node ends before parent start: '+NodeToPathName(Node));
+      if (MaxPos <> -1) and (Node.EndPos >  MaxPos) then
+        Test.Fail('Node ends after parent ends: '+NodeToPathName(Node));
+
+      if (Node.EndPos >= 0) and (Node.EndPos < Node.StartPos) then
+        Test.Fail('Node ends before its own start: '+NodeToPathName(Node));
+
+      if not (Node.Desc in [
+        ctnVariantType,  // typeless proc parameter
+        ctnProcedureHead // e.g. anon proc
+      ]) then
+        if Node.StartPos = Node.EndPos then
+          Test.Fail('Node is empty: '+NodeToPathName(Node));
+
+      LastChildNode := CheckNode(Node.FirstChild, Node.StartPos, Node.EndPos, (Node.NextBrother = nil));
+      if LastChildNode <> Node.LastChild then
+        Test.Fail('Node has wrong lastchild: '+NodeToPathName(Node));
+
+      BrotherEnd := Node.StartPos;
+      Result := Node;
+      Node := Node.NextBrother;
+      if (Node <> nil) and (Node.PriorBrother <> Result) then
+        Test.Fail('Node has wrong prior brother: '+NodeToPathName(Node));
+
+    until Node = nil;
+  end;
+begin
+  CheckNode(Tool.Tree.Root, 0, MaxInt, True);
+end;
+
 { TCustomTestPascalParser }
 
 procedure TCustomTestPascalParser.SetUp;
@@ -173,6 +249,7 @@ var
 begin
   Add('end.');
   DoParseModule(Code,Tool);
+  CheckNodeTree(Tool.Scanner.MainFilename, Tool, Self);
 end;
 
 procedure TCustomTestPascalParser.CheckParseError(