Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 10 additions & 1 deletion Source/DelphiAST.Classes.pas
Original file line number Diff line number Diff line change
Expand Up @@ -19,10 +19,12 @@ EParserException = class(Exception)
property Line: Integer read FLine;
property Col: Integer read FCol;
end;

TAttributeEntry = TPair<TAttributeName, string>;
PAttributeEntry = ^TAttributeEntry;

TCommentNode = class;

TSyntaxNodeClass = class of TSyntaxNode;
TSyntaxNode = class
private
Expand All @@ -37,6 +39,7 @@ TSyntaxNode = class
FChildNodes: TArray<TSyntaxNode>;
FTyp: TSyntaxNodeType;
FParentNode: TSyntaxNode;
FLastPrecedingCommentNode: TCommentNode;
public
constructor Create(Typ: TSyntaxNodeType);
destructor Destroy; override;
Expand All @@ -63,6 +66,11 @@ TSyntaxNode = class
property Typ: TSyntaxNodeType read FTyp;
property ParentNode: TSyntaxNode read FParentNode;

{ The last comment node that preceeds this node.
Only available after TPasSyntaxTreeBuilder.AttachCommentNodes has been
called. }
property LastPrecedingCommentNode: TCommentNode read FLastPrecedingCommentNode write FLastPrecedingCommentNode;

property Col: Integer read FCol write FCol;
property Line: Integer read FLine write FLine;
end;
Expand Down Expand Up @@ -422,6 +430,7 @@ function TSyntaxNode.Clone: TSyntaxNode;
Result.Col := Self.Col;
Result.Line := Self.Line;
Result.FileName := Self.FileName;
Result.FLastPrecedingCommentNode := Self.FLastPrecedingCommentNode;
end;

constructor TSyntaxNode.Create(Typ: TSyntaxNodeType);
Expand Down
80 changes: 79 additions & 1 deletion Source/DelphiAST.pas
Original file line number Diff line number Diff line change
Expand Up @@ -56,6 +56,14 @@ TPasSyntaxTreeBuilder = class(TmwSimplePasPar)
procedure CallInheritedExpression;
procedure SetCurrentCompoundNodesEndPosition;
procedure DoOnComment(Sender: TObject; const Text: string);
private
FCommentIndex: Integer;
FCommentNode: TCommentNode;
FCommentText: String;
FCommentPos: UInt32;
function SetActiveComment(const Index: Integer): Boolean;
procedure ApplyCommentNodes(const Node, PrevNode: TSyntaxNode);
class function GetNodePos(const Node: TSyntaxNode): UInt32; static;
protected
FStack: TNodeStack;
FComments: TObjectList<TCommentNode>;
Expand Down Expand Up @@ -237,6 +245,11 @@ TPasSyntaxTreeBuilder = class(TmwSimplePasPar)
class function Run(const FileName: string;
InterfaceOnly: Boolean = False; IncludeHandler: IIncludeHandler = nil): TSyntaxNode; reintroduce; overload; static;

{ Sets the LastPrecedingCommentNode property of each node to the last
comment that preceeds the node.
Root must be the node returned from Run. }
procedure AttachCommentNodes(const Root: TSyntaxNode);

property Comments: TObjectList<TCommentNode> read FComments;
end;

Expand Down Expand Up @@ -333,6 +346,38 @@ procedure TPasSyntaxTreeBuilder.AnonymousMethod;
end;
end;

procedure TPasSyntaxTreeBuilder.ApplyCommentNodes(const Node,
PrevNode: TSyntaxNode);
var
LastNode, Child: TSyntaxNode;
begin
Assert(Assigned(Node));
Assert(Assigned(PrevNode));

{ Use "while True" loop so that if multiple comments preceed a declaration,
only the last one is used. }
while True do
begin
if (FCommentPos > GetNodePos(PrevNode)) and (FCommentPos < GetNodePos(Node)) then
begin
Node.LastPrecedingCommentNode := FCommentNode;
if (not SetActiveComment(FCommentIndex + 1)) then
Exit;
end
else
Break;
end;

LastNode := Node;
for Child in Node.ChildNodes do
begin
ApplyCommentNodes(Child, LastNode);
if (FCommentNode = nil) then
Exit;
LastNode := Child;
end;
end;

procedure TPasSyntaxTreeBuilder.ArrayBounds;
begin
FStack.Push(ntBounds);
Expand Down Expand Up @@ -396,6 +441,12 @@ procedure TPasSyntaxTreeBuilder.AtExpression;
end;
end;

procedure TPasSyntaxTreeBuilder.AttachCommentNodes(const Root: TSyntaxNode);
begin
if SetActiveComment(0) then
ApplyCommentNodes(Root, Root);
end;

procedure TPasSyntaxTreeBuilder.Attribute;
begin
FStack.Push(ntAttribute);
Expand Down Expand Up @@ -1288,6 +1339,19 @@ procedure TPasSyntaxTreeBuilder.FunctionProcedureName;
end;
end;

class function TPasSyntaxTreeBuilder.GetNodePos(
const Node: TSyntaxNode): UInt32;
var
Line, Col: UInt32;
begin
Assert(Assigned(Node));
Line := Node.Line;
Col := Node.Col;
if (Col > 255) then
Col := 255;
Result := (Line shl 24) or Col;
end;

procedure TPasSyntaxTreeBuilder.GotoStatement;
begin
FStack.Push(ntGoto);
Expand Down Expand Up @@ -1548,7 +1612,7 @@ procedure TPasSyntaxTreeBuilder.DoOnComment(Sender: TObject; const Text: string)
begin
case TokenID of
ptAnsiComment: Node := TCommentNode.Create(ntAnsiComment);
ptBorComment: Node := TCommentNode.Create(ntAnsiComment);
ptBorComment: Node := TCommentNode.Create(ntBorComment);
ptSlashesComment: Node := TCommentNode.Create(ntSlashesComment);
else
raise EParserException.Create(Lexer.PosXY.Y, Lexer.PosXY.X, Lexer.FileName, 'Invalid comment type');
Expand Down Expand Up @@ -1869,6 +1933,20 @@ function TPasSyntaxTreeBuilder.NodeListToString(NamesNode: TSyntaxNode): string;
end;
end;

function TPasSyntaxTreeBuilder.SetActiveComment(const Index: Integer): Boolean;
begin
Result := (Index < FComments.Count);
if (Result) then
begin
FCommentIndex := Index;
FCommentNode := FComments[Index];
FCommentText := FCommentNode.Text;
FCommentPos := GetNodePos(FCommentNode);
end
else
FCommentNode := nil;
end;

procedure TPasSyntaxTreeBuilder.SetConstructor;
begin
FStack.Push(ntSet);
Expand Down
20 changes: 20 additions & 0 deletions Source/SimpleParser/SimpleParser.Lexer.pas
Original file line number Diff line number Diff line change
Expand Up @@ -1483,6 +1483,9 @@ procedure TmwBasePasLex.BorProc;
end;

procedure TmwBasePasLex.BraceOpenProc;
var
BeginRun: Integer;
CommentText: String;
begin
case FBuffer.Buf[FBuffer.Run + 1] of
'$': FTokenID := GetDirectiveKind;
Expand All @@ -1493,10 +1496,17 @@ procedure TmwBasePasLex.BraceOpenProc;
end;
end;
Inc(FBuffer.Run);
BeginRun := FBuffer.Run; // EvB
while FBuffer.Buf[FBuffer.Run] <> #0 do
case FBuffer.Buf[FBuffer.Run] of
'}':
begin
if (FTokenId = ptBorComment) and Assigned(FOnComment) then
begin
SetString(CommentText, PChar(@FBuffer.Buf[BeginRun]), FBuffer.Run - BeginRun);
FOnComment(Self, CommentText);
end;

FCommentState := csNo;
Inc(FBuffer.Run);
Break;
Expand Down Expand Up @@ -1990,6 +2000,9 @@ procedure TmwBasePasLex.AnsiProc;
end;

procedure TmwBasePasLex.RoundOpenProc;
var
CommentText: String;
BeginRun: Integer;
begin
Inc(FBuffer.Run);
case FBuffer.Buf[FBuffer.Run] of
Expand All @@ -2001,11 +2014,18 @@ procedure TmwBasePasLex.RoundOpenProc;
else
FCommentState := csAnsi;
Inc(FBuffer.Run);
BeginRun := FBuffer.Run; // EvB
while FBuffer.Buf[FBuffer.Run] <> #0 do
case FBuffer.Buf[FBuffer.Run] of
'*':
if FBuffer.Buf[FBuffer.Run + 1] = ')' then
begin
if (FTokenId = ptAnsiComment) and Assigned(FOnComment) then
begin
SetString(CommentText, PChar(@FBuffer.Buf[BeginRun]), FBuffer.Run - BeginRun);
FOnComment(Self, CommentText);
end;

FCommentState := csNo;
Inc(FBuffer.Run, 2);
Break;
Expand Down