diff --git a/components/codetools/tests/laztests/bug32252.pas b/components/codetools/tests/laztests/bug32252.pas index f87f8ab8b0..8772d4de83 100644 --- a/components/codetools/tests/laztests/bug32252.pas +++ b/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} diff --git a/components/codetools/tests/laztests/bug40145.pas b/components/codetools/tests/laztests/bug40145.pas index a0da18785c..bb54cf0235 100644 --- a/components/codetools/tests/laztests/bug40145.pas +++ b/components/codetools/tests/laztests/bug40145.pas @@ -1,4 +1,4 @@ -unit bug40145; +unit bug40145;{%skipnodechecks} {$mode delphi}{$H+} diff --git a/components/codetools/tests/moduletests/fdt_generics_finddeclaration.pas b/components/codetools/tests/moduletests/fdt_generics_finddeclaration.pas index 815bd2e69d..afbb865bf5 100644 --- a/components/codetools/tests/moduletests/fdt_generics_finddeclaration.pas +++ b/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+} diff --git a/components/codetools/tests/moduletests/fdt_generics_guesstype.pas b/components/codetools/tests/moduletests/fdt_generics_guesstype.pas index 25b3ac560a..c3540596ed 100644 --- a/components/codetools/tests/moduletests/fdt_generics_guesstype.pas +++ b/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+} diff --git a/components/codetools/tests/moduletests/fdt_generics_guesstype2.pas b/components/codetools/tests/moduletests/fdt_generics_guesstype2.pas index 26e217957c..98e0314460 100644 --- a/components/codetools/tests/moduletests/fdt_generics_guesstype2.pas +++ b/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+} diff --git a/components/codetools/tests/testfinddeclaration.pas b/components/codetools/tests/testfinddeclaration.pas index 45df26cbfb..d1df9bafe1 100644 --- a/components/codetools/tests/testfinddeclaration.pas +++ b/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;', diff --git a/components/codetools/tests/testpascalparser.pas b/components/codetools/tests/testpascalparser.pas index 61db5e6977..714e821214 100644 --- a/components/codetools/tests/testpascalparser.pas +++ b/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(