diff --git a/Source/DelphiAST.pas b/Source/DelphiAST.pas index a451163..4f8bd86 100644 --- a/Source/DelphiAST.pas +++ b/Source/DelphiAST.pas @@ -63,8 +63,12 @@ TPasSyntaxTreeBuilder = class(TmwSimplePasParEx) procedure DoOnComment(Sender: TObject; const Text: string); function DequoteString(const S: string): string; function GetMainSection(Node: TSyntaxNode): TSyntaxNode; + procedure PushRootNode(Typ: TSyntaxNodeType); protected FStack: TNodeStack; + //Compiler directives that come before the `unit`/`program`/`library`/`package` keyword, + //when there is no root node yet to put them under. PushRootNode adopts them. + FLeadingDirectives: TList; FComments: TObjectList; procedure AccessSpecifier; override; procedure AdditiveOperator; override; @@ -1148,6 +1152,18 @@ function TPasSyntaxTreeBuilder.GetMainSection(Node: TSyntaxNode): TSyntaxNode; Result:= Node; end; +procedure TPasSyntaxTreeBuilder.PushRootNode(Typ: TSyntaxNodeType); +var + Node: TSyntaxNode; +begin + FStack.Push(TSyntaxNode.Create(Typ)); + AssignLexerPositionToNode(Lexer, FStack.Peek); + //A directive before the keyword goes where one right after it would: under the root. + for Node in FLeadingDirectives do + FStack.Peek.AddChild(Node); + FLeadingDirectives.Clear; +end; + procedure TPasSyntaxTreeBuilder.CompilerDirective; var Directive: string; @@ -1158,11 +1174,19 @@ procedure TPasSyntaxTreeBuilder.CompilerDirective; Directive:= Uppercase(Lexer.Token); //Always place the compiler directive directly under the `ntInterface` or `ntImplementation` node //or in the main section in a library, program or package. - Root:= GetMainSection(FStack.Peek); + //A directive before the `unit` keyword comes before any node exists; hold on to it until + //PushRootNode creates the root. + if FStack.Count = 0 then + Root:= nil + else + Root:= GetMainSection(FStack.Peek); Node:= TValuedSyntaxNode.Create(ntCompilerDirective); AssignLexerPositionToNode(Lexer, Node); Node.Value:= Directive; - Root.AddChild(Node); + if Assigned(Root) then + Root.AddChild(Node) + else + FLeadingDirectives.Add(Node); //Parse the directive if (Directive.StartsWith('(*$')) then begin Delete(Directive, 1, 3); @@ -1367,6 +1391,7 @@ constructor TPasSyntaxTreeBuilder.Create; begin inherited; FStack := TNodeStack.Create(Lexer); + FLeadingDirectives := TList.Create; FComments := TObjectList.Create(True); OnComment := DoOnComment; end; @@ -1392,8 +1417,13 @@ function TPasSyntaxTreeBuilder.DequoteString(const S: string): string; end; destructor TPasSyntaxTreeBuilder.Destroy; +var + Node: TSyntaxNode; begin FStack.Free; + for Node in FLeadingDirectives do + Node.Free; + FLeadingDirectives.Free; FComments.Free; inherited; end; @@ -2158,8 +2188,7 @@ procedure TPasSyntaxTreeBuilder.LabelId; procedure TPasSyntaxTreeBuilder.LibraryFile; begin //Assert(FStack.Peek.ParentNode = nil); - FStack.Push(TSyntaxNode.Create(ntLibrary)); - AssignLexerPositionToNode(Lexer, FStack.Peek); + PushRootNode(ntLibrary); inherited; //Stack.pop is done in `Run` end; @@ -2355,8 +2384,7 @@ procedure TPasSyntaxTreeBuilder.OutParameter; procedure TPasSyntaxTreeBuilder.PackageFile; begin //Assert(FStack.Peek.ParentNode = nil); - FStack.Push(TSyntaxNode.Create(ntPackage)); - AssignLexerPositionToNode(Lexer, FStack.Peek); + PushRootNode(ntPackage); inherited; //Stack.pop is done in `Run` end; @@ -2451,8 +2479,7 @@ procedure TPasSyntaxTreeBuilder.ProcedureProcedureName; procedure TPasSyntaxTreeBuilder.ProgramFile; begin //Assert(FStack.Peek.ParentNode = nil); - FStack.Push(TSyntaxNode.Create(ntProgram)); - AssignLexerPositionToNode(Lexer, FStack.Peek); + PushRootNode(ntProgram); inherited; //Stack.pop is done in `Run` end; @@ -2657,10 +2684,15 @@ class function TPasSyntaxTreeBuilder.Run(const FileName: string; end; function TPasSyntaxTreeBuilder.Run(SourceStream: TStream): TSyntaxNode; +var + Node: TSyntaxNode; begin Result:= nil; try FStack.Clear; + for Node in FLeadingDirectives do + Node.Free; + FLeadingDirectives.Clear; try self.OnMessage := ParserMessage; inherited Run('', SourceStream); @@ -3117,8 +3149,7 @@ procedure TPasSyntaxTreeBuilder.UnaryMinus; procedure TPasSyntaxTreeBuilder.UnitFile; begin //Assert(FStack.Peek.ParentNode = nil); - FStack.Push(TSyntaxNode.Create(ntUnit)); - AssignLexerPositionToNode(Lexer, FStack.Peek); + PushRootNode(ntUnit); inherited; //Stack.pop is done in `Run` end; diff --git a/Test/UnitTests/DelphiAST.Tests.pas b/Test/UnitTests/DelphiAST.Tests.pas index b69a872..910fb4f 100644 --- a/Test/UnitTests/DelphiAST.Tests.pas +++ b/Test/UnitTests/DelphiAST.Tests.pas @@ -317,6 +317,26 @@ procedure TestUnicodeStringTypecast; end; end; +procedure TestDirectiveBeforeUnit; +var + Root: TSyntaxNode; +begin + Root := ParseSource('{$WARN UNIT_PLATFORM OFF}' + sLineBreak + '{$D+}' + sLineBreak + + 'unit Example; interface implementation end.'); + try + AssertNotNil(Root, 'Missing root'); + AssertTrue(Root.Typ = ntUnit, 'The root is the unit.'); + AssertTrue(Root.ChildNodes[0].Typ = ntCompilerDirective, 'First directive under the root.'); + AssertEquals('WARN', Root.ChildNodes[0].GetAttribute(anType), 'First directive, in source order.'); + AssertEquals(1, Root.ChildNodes[0].Line, 'First directive line.'); + AssertTrue(Root.ChildNodes[1].Typ = ntCompilerDirective, 'Second directive under the root.'); + AssertEquals('D', Root.ChildNodes[1].GetAttribute(anType), 'Second directive, in source order.'); + AssertNotNil(FindDescendant(Root, ntImplementation), 'The rest of the unit still parses.'); + finally + Root.Free; + end; +end; + procedure TestInvalidSyntax; var Root: TSyntaxNode; @@ -397,6 +417,7 @@ procedure RunAllTests; RunTest('Node.AttributeRemove', TestAttributeRemove); RunTest('AST.RepeatedCallingConvention', TestRepeatedCallingConvention); RunTest('AST.UnicodeStringTypecast', TestUnicodeStringTypecast); + RunTest('AST.DirectiveBeforeUnit', TestDirectiveBeforeUnit); RunTest('Parser.InvalidSyntax', TestInvalidSyntax); RunTest('Parser.UnexpectedEndOfFilePosition', TestUnexpectedEndOfFilePosition); {$IFNDEF FPC}