Rootnode can now be of multiple types (not just Unit)

Source/DelphiAST.Consts.pas

@@ -65,6 +65,7 @@ interface
     ntImplementation,
     ntImplements,
     ntIn,
+    ntInclude,
     ntIndex,
     ntIndexed,
     ntInherited,
@@ -73,6 +74,7 @@ interface
     ntIs,
     ntLabel,
     ntLHS,
+    ntLibrary,
     ntLiteral,
     ntLower,
     ntLowerEqual,
@@ -90,6 +92,7 @@ interface
     ntParameters,
     ntPath,
     ntPositionalArgument,
+    ntProgramm,
     ntProtected,
     ntPrivate,
     ntProperty,
@@ -220,6 +223,7 @@ interface
     'implementation',
     'implements',
     'in',
+    'include',
     'index',
     'indexed',
     'inherited',
@@ -228,6 +232,7 @@ interface
     'is',
     'label',
     'lhs',
+    'library',
     'literal',
     'lower',
     'lowerequal',
@@ -245,6 +250,7 @@ interface
     'parameters',
     'path',
     'positionalargument',
+    'programm',
     'protected',
     'private',
     'property',

Source/DelphiAST.ProjectIndexer.pas

@@ -103,7 +103,7 @@     TIncludeHandler = class(TInterfacedObject, IIncludeHandler)
     FUnitPaths      : TUnitPathsCache;
   strict protected
     procedure AppendUnits(usesNode: TSyntaxNode; const filePath: string; unitList: TStrings);
-    procedure BuildUsesList(unitNode: TSyntaxNode; const fileName: string; isProject: boolean;
+    procedure BuildUsesList(rootNode: TSyntaxNode; const fileName: string; isProject: boolean;
       unitList: TStringList);
     function  FindType(node: TSyntaxNode; nodeType: TSyntaxNodeType): TSyntaxNode;
     procedure GetUnitSyntax(const fileName: string; var syntaxTree: TSyntaxNode; var
@@ -243,7 +243,7 @@ procedure TProjectIndexer.AppendUnits(usesNode: TSyntaxNode; const filePath: str
     end;
 end;
 
-procedure TProjectIndexer.BuildUsesList(unitNode: TSyntaxNode; const fileName: string;
+procedure TProjectIndexer.BuildUsesList(rootNode: TSyntaxNode; const fileName: string;
   isProject: boolean; unitList: TStringList);
 var
   fileFolder: string;
@@ -253,21 +253,21 @@ procedure TProjectIndexer.BuildUsesList(unitNode: TSyntaxNode; const fileName: s
 begin
   fileFolder := IncludeTrailingPathDelimiter(ExtractFilePath(fileName));
   if isProject then begin
-    usesNode := FindType(unitNode, ntUses);
+    usesNode := FindType(rootNode, ntUses);
     if assigned(usesNode) then
       AppendUnits(usesNode, fileFolder, unitList);
-    usesNode := FindType(unitNode, ntContains);
+    usesNode := FindType(rootNode, ntContains);
     if assigned(usesNode) then
       AppendUnits(usesNode, fileFolder, unitList);
   end
   else begin
-    intfNode := FindType(unitNode, ntInterface);
+    intfNode := FindType(rootNode, ntInterface);
     if assigned(intfNode) then begin
       usesNode := FindType(intfNode, ntUses);
       if assigned(usesNode) then
         AppendUnits(usesNode, fileFolder, unitList);
     end;
-    implNode := FindType(unitNode, ntImplementation);
+    implNode := FindType(rootNode, ntImplementation);
     if assigned(implNode) then begin
       usesNode := FindType(implNode, ntUses);
       if assigned(usesNode) then
@@ -518,17 +518,12 @@ procedure TProjectIndexer.ScanUsedUnits(const unitName, fileName: string; isProj
   syntaxTree: TSyntaxNode; syntaxTreeFromParser: boolean);
 var
   unitList: TStringList;
-  unitNode: TSyntaxNode;
   usesName: string;
   usesPath: string;
 begin
-  unitNode := FindType(syntaxTree, ntUnit);
-  if not assigned(unitNode) then
-    Exit;
-
   unitList := TStringList.Create;
   try
-    BuildUsesList(unitNode, fileName, isProject, unitList);
+    BuildUsesList(syntaxTree, fileName, isProject, unitList);
 
     NotifyUnitParsed(unitName, fileName, syntaxTree, syntaxTreeFromParser);
 

Source/DelphiAST.pas

@@ -61,7 +61,9 @@   TPasSyntaxTreeBuilder = class(TmwSimplePasParEx)
     procedure CallInheritedPropertyParameterList;
     procedure SetCurrentCompoundNodesEndPosition;
     procedure DoOnComment(Sender: TObject; const Text: string);
+    procedure PushRootNode(Typ: TSyntaxNodeType);
   protected
+    FRootNode: TSyntaxNode;
     FStack: TNodeStack;
     FComments: TObjectList<TCommentNode>;
     procedure AccessSpecifier; override;
@@ -145,6 +147,7 @@   TPasSyntaxTreeBuilder = class(TmwSimplePasParEx)
     procedure Identifier; override;
     procedure ImplementationSection; override;
     procedure ImplementsSpecifier; override;
+    procedure IncludeFile; override;
     procedure IndexSpecifier; override;
     procedure IndexOp; override;
     procedure InheritedStatement; override;
@@ -157,6 +160,7 @@   TPasSyntaxTreeBuilder = class(TmwSimplePasParEx)
     procedure InterfaceSection; override;
     procedure InterfaceType; override;
     procedure LabelId; override;
+    procedure LibraryFile; override;
     procedure MainUsesClause; override;
     procedure MainUsedUnitStatement; override;
     procedure MethodKind; override;
@@ -166,6 +170,7 @@   TPasSyntaxTreeBuilder = class(TmwSimplePasParEx)
     procedure Number; override;
     procedure ObjectNameOfMethod; override;
     procedure OutParameter; override;
+    procedure PackageFile; override;
     procedure ParameterFormal; override;
     procedure ParameterName; override;
     procedure PointerSymbol; override;
@@ -174,6 +179,7 @@   TPasSyntaxTreeBuilder = class(TmwSimplePasParEx)
     procedure ProcedureHeading; override;
     procedure ProcedureDeclarationSection; override;
     procedure ProcedureProcedureName; override;
+    procedure ProgramFile; override;
     procedure PropertyName; override;
     procedure PropertyParameterList; override;
     procedure RaiseStatement; override;
@@ -1501,6 +1507,16 @@ procedure TPasSyntaxTreeBuilder.ImplementsSpecifier;
   end;
 end;
 
+procedure TPasSyntaxTreeBuilder.IncludeFile;
+begin
+  PushRootNode(ntInclude);
+  try
+    inherited;
+  finally
+    FStack.Pop;
+  end;
+end;
+
 procedure TPasSyntaxTreeBuilder.IndexOp;
 begin
   FStack.Push(ntIndexed);
@@ -1635,6 +1651,16 @@ procedure TPasSyntaxTreeBuilder.LabelId;
   inherited;
 end;
 
+procedure TPasSyntaxTreeBuilder.LibraryFile;
+begin
+  PushRootNode(ntLibrary);
+  try
+    inherited;
+  finally
+    FStack.Pop;
+  end;
+end;
+
 procedure TPasSyntaxTreeBuilder.MainUsedUnitStatement;
 var
   NameNode, PathNode, PathLiteralNode, Temp: TSyntaxNode;
@@ -1787,6 +1813,16 @@ procedure TPasSyntaxTreeBuilder.OutParameter;
   end;
 end;
 
+procedure TPasSyntaxTreeBuilder.PackageFile;
+begin
+  PushRootNode(ntPackage);
+  try
+    inherited;
+  finally
+    FStack.Pop;
+  end;
+end;
+
 procedure TPasSyntaxTreeBuilder.ParameterFormal;
 begin
   FStack.Push(ntParameters);
@@ -1868,6 +1904,16 @@ procedure TPasSyntaxTreeBuilder.PropertyName;
   inherited PropertyName;
 end;
 
+procedure TPasSyntaxTreeBuilder.ProgramFile;
+begin
+  PushRootNode(ntProgramm);
+  try
+    inherited;
+  finally
+    FStack.Pop;
+  end;
+end;
+
 procedure TPasSyntaxTreeBuilder.PropertyParameterList;
 var
   TreeBuilderMethod: TTreeBuilderMethod;
@@ -2047,26 +2093,29 @@ class function TPasSyntaxTreeBuilder.Run(const FileName: string;
 
 function TPasSyntaxTreeBuilder.Run(SourceStream: TStream): TSyntaxNode;
 begin
-  Result := TSyntaxNode.Create(ntUnit);
   try
+    FRootNode := nil;
     FStack.Clear;
-    FStack.Push(Result);
-    try
-      self.OnMessage := ParserMessage;
-      inherited Run('', SourceStream);
-    finally
-      FStack.Pop;
-    end;
+    self.OnMessage := ParserMessage;
+    inherited Run('', SourceStream);
   except
     on E: EParserException do
-      raise ESyntaxTreeException.Create(E.Line, E.Col, Lexer.FileName, E.Message, Result);
+      if FRootNode <> nil then
+        raise ESyntaxTreeException.Create(E.Line, E.Col, Lexer.FileName, E.Message, FRootNode)
+      else
+        raise;
     on E: ESyntaxError do
-      raise ESyntaxTreeException.Create(E.PosXY.X, E.PosXY.Y, Lexer.FileName, E.Message, Result);
+      if FRootNode <> nil then
+        raise ESyntaxTreeException.Create(E.PosXY.X, E.PosXY.Y, Lexer.FileName, E.Message, FRootNode)
+      else
+        raise;
     else
-      FreeAndNil(Result);
+      FreeAndNil(FRootNode);
       raise;
   end;
 
+  Result := FRootNode;
+
   Assert(FStack.Count = 0);
 end;
 
@@ -2458,12 +2507,13 @@ procedure TPasSyntaxTreeBuilder.UnaryMinus;
 end;
 
 procedure TPasSyntaxTreeBuilder.UnitFile;
-var
-  Temp: TSyntaxNode;
 begin
-  Temp := FStack.Peek;
-  AssignLexerPositionToNode(Lexer, Temp);
-  inherited;
+  PushRootNode(ntUnit);
+  try
+    inherited;
+  finally
+    FStack.Pop;
+  end;
 end;
 
 procedure TPasSyntaxTreeBuilder.UnitId;
@@ -2730,6 +2780,16 @@ procedure TPasSyntaxTreeBuilder.WithStatement;
   end;
 end;
 
+procedure TPasSyntaxTreeBuilder.PushRootNode(Typ: TSyntaxNodeType);
+begin
+  Assert(FRootNode = nil); 
+  Assert(FStack.Count = 0);
+
+  FRootNode := TSyntaxNode.Create(Typ);
+
+  FStack.Push(FRootNode);
+end;
+
 { ESyntaxTreeException }
 
 constructor ESyntaxTreeException.Create(Line, Col: Integer; const FileName, Msg: string;

Test/Snippets/libraryrootnode.dpr

@@ -0,0 +1,5 @@
+library libraryrootnode;
+
+begin
+
+end.

Test/Snippets/packagerootnode.dpk

@@ -0,0 +1,4 @@
+package packagerootnode;
+
+
+end.

Test/Snippets/programmrootnode.dpr

@@ -0,0 +1,5 @@
+program programmrootnode;
+
+begin
+
+end.

Test/uMainForm.pas

@@ -47,14 +47,29 @@ procedure TForm2.btnRunClick(Sender: TObject);
 var
   Path, FileName: string;
   SyntaxTree: TSyntaxNode;
+  FileNames : TArray<string>;
 begin
   memLog.Clear;
 
   Path := ExtractFilePath(Application.ExeName) + 'Snippets\';
   if not SelectDirectory('Select Folder', '', Path) then
     Exit;
 
-  for FileName in TDirectory.GetFiles(Path, '*.pas', TSearchOption.soAllDirectories) do
+  FileNames :=
+    TDirectory.GetFiles(Path, TSearchOption.soAllDirectories,
+      function(const Path: string; const SearchRec: TSearchRec): Boolean
+      var
+        Extension : string;
+      begin
+        Extension := TPath.GetExtension(SearchRec.Name);
+
+        Result := SameText(extension, '.pas')
+               OR SameText(extension, '.dpr')
+               OR SameText(extension, '.dpk')
+               OR SameText(extension, '.inc');
+      end);
+
+  for FileName in FileNames do
   begin
     try
       SyntaxTree := TPasSyntaxTreeBuilder.Run(FileName, False, TIncludeHandler.Create(Path));