diff --git a/Source/DelphiAST.Classes.pas b/Source/DelphiAST.Classes.pas index 10b785b..8752255 100644 --- a/Source/DelphiAST.Classes.pas +++ b/Source/DelphiAST.Classes.pas @@ -104,6 +104,8 @@ TCompoundSyntaxNode = class(TSyntaxNode) FEndLine: Integer; public function Clone: TSyntaxNode; override; + //counterpart to AssignPositionFrom, for a node rebuilt from a parsed one + procedure AssignEndPositionFrom(const Node: TCompoundSyntaxNode); property EndCol: Integer read FEndCol write FEndCol; property EndLine: Integer read FEndLine write FEndLine; @@ -629,6 +631,12 @@ procedure TSyntaxNode.AssignPositionFrom(const Node: TSyntaxNode); { TCompoundSyntaxNode } +procedure TCompoundSyntaxNode.AssignEndPositionFrom(const Node: TCompoundSyntaxNode); +begin + FEndCol := Node.EndCol; + FEndLine := Node.EndLine; +end; + function TCompoundSyntaxNode.Clone: TSyntaxNode; begin Result := inherited; diff --git a/Source/DelphiAST.pas b/Source/DelphiAST.pas index 7a1dcb5..5ff7b5c 100644 --- a/Source/DelphiAST.pas +++ b/Source/DelphiAST.pas @@ -1195,9 +1195,11 @@ procedure TPasSyntaxTreeBuilder.CompoundStatement; procedure TPasSyntaxTreeBuilder.ConstantDeclaration; begin - FStack.Push(ntConstant); + //compound: a constant's value can span lines, so record where it ends. as TypeDeclaration. + FStack.PushCompoundSyntaxNode(ntConstant); try inherited; + SetCurrentCompoundNodesEndPosition; finally FStack.Pop; end; @@ -1329,9 +1331,12 @@ procedure TPasSyntaxTreeBuilder.ConstSection; if Constant.Typ <> ntName then Continue; - Temp := FStack.Push(ConstList.Typ); + //compound: start from the name, end from the ConstList that measured the value. + Temp := FStack.PushCompoundSyntaxNode(ConstList.Typ); try Temp.AssignPositionFrom(Constant); + if ConstList is TCompoundSyntaxNode then + TCompoundSyntaxNode(Temp).AssignEndPositionFrom(TCompoundSyntaxNode(ConstList)); FStack.AddChild(Constant.Clone); if Assigned(TypeInfo) then @@ -3205,9 +3210,11 @@ procedure TPasSyntaxTreeBuilder.VarAbsolute; procedure TPasSyntaxTreeBuilder.VarDeclaration; begin - FStack.Push(ntVariables); + //compound: a variable's type or initialiser can span lines, so record where it ends. + FStack.PushCompoundSyntaxNode(ntVariables); try inherited; + SetCurrentCompoundNodesEndPosition; finally FStack.Pop; end; @@ -3298,9 +3305,12 @@ procedure TPasSyntaxTreeBuilder.RearrangeVarSection(const VarSect: TSyntaxNode); begin if Variable.Typ <> ntName then Continue; - Temp := FStack.Push(ntVariable); + //compound: start from the name, end from the VarList that measured the declaration. + Temp := FStack.PushCompoundSyntaxNode(ntVariable); try Temp.AssignPositionFrom(Variable); + if VarList is TCompoundSyntaxNode then + TCompoundSyntaxNode(Temp).AssignEndPositionFrom(TCompoundSyntaxNode(VarList)); FStack.AddChild(Variable.Clone); if Assigned(TypeInfo) then FStack.AddChild(TypeInfo.Clone); diff --git a/Test/UnitTests/DelphiAST.Tests.pas b/Test/UnitTests/DelphiAST.Tests.pas index 6d15948..c46a2bb 100644 --- a/Test/UnitTests/DelphiAST.Tests.pas +++ b/Test/UnitTests/DelphiAST.Tests.pas @@ -177,6 +177,70 @@ procedure TestSourcePositions; end; end; +procedure TestConstantEndPosition; +var + Root, ConstsNode, Node, Spanning, Single: TSyntaxNode; +begin + Root := ParseSource('unit Consts;' + sLineBreak + 'interface' + sLineBreak + 'const' + + sLineBreak + ' Spanning = ''first part '' +' + sLineBreak + ' ''second part'';' + + sLineBreak + ' Single = 42;' + sLineBreak + 'implementation' + sLineBreak + 'end.'); + try + ConstsNode := FindDescendant(Root, ntConstants); + AssertNotNil(ConstsNode, 'No const section was produced'); + Spanning := nil; + Single := nil; + for Node in ConstsNode.ChildNodes do + if Node.Typ = ntConstant then + if Node.Line = 4 then + Spanning := Node + else if Node.Line = 6 then + Single := Node; + + AssertNotNil(Spanning, 'No constant starting on line 4'); + AssertTrue(Spanning is TCompoundSyntaxNode, + 'Constant node must be compound so it can carry an end position'); + AssertEquals(5, TCompoundSyntaxNode(Spanning).EndLine, + 'A multi-line constant must reach the last line of its value'); + + AssertNotNil(Single, 'No constant starting on line 6'); + AssertEquals(6, TCompoundSyntaxNode(Single).EndLine, + 'A single-line constant must end on its own line, not run on to what follows'); + finally + Root.Free; + end; +end; + +procedure TestVariableEndPosition; +var + Root, Node, Spanning, Single: TSyntaxNode; +begin + Root := ParseSource('unit Vars;' + sLineBreak + 'interface' + sLineBreak + 'var' + + sLineBreak + ' Spanning: array[0..1] of' + sLineBreak + ' Integer;' + sLineBreak + + ' Single: Integer;' + sLineBreak + 'implementation' + sLineBreak + 'end.'); + try + Spanning := nil; + Single := nil; + for Node in FindDescendant(Root, ntVariables).ChildNodes do + if Node.Typ = ntVariable then + if Node.Line = 4 then + Spanning := Node + else if Node.Line = 6 then + Single := Node; + + AssertNotNil(Spanning, 'No variable starting on line 4'); + AssertTrue(Spanning is TCompoundSyntaxNode, + 'Variable node must be compound so it can carry an end position'); + AssertEquals(5, TCompoundSyntaxNode(Spanning).EndLine, + 'A variable whose declaration spans lines must reach its last line'); + + AssertNotNil(Single, 'No variable starting on line 6'); + AssertEquals(6, TCompoundSyntaxNode(Single).EndLine, + 'A single-line variable must end on its own line, not run on to what follows'); + finally + Root.Free; + end; +end; + procedure TestInvalidSyntax; var Root: TSyntaxNode; @@ -229,6 +293,8 @@ procedure RunAllTests; RunTest('AST.GenericRecordAndProperty', TestGenericRecordAndProperty); RunTest('Writer.LiteralsUnicodeAndXmlEscaping', TestLiteralsAndUnicode); RunTest('AST.SourcePositions', TestSourcePositions); + RunTest('AST.ConstantEndPosition', TestConstantEndPosition); + RunTest('AST.VariableEndPosition', TestVariableEndPosition); RunTest('Parser.InvalidSyntax', TestInvalidSyntax); {$IFNDEF FPC} RunTest('Serialization.BinaryRoundTrip', TestBinarySerializationRoundTrip);