diff --git a/Source/DelphiAST.Consts.pas b/Source/DelphiAST.Consts.pas index fce4ccd..20b7902 100644 --- a/Source/DelphiAST.Consts.pas +++ b/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', diff --git a/Source/DelphiAST.ProjectIndexer.pas b/Source/DelphiAST.ProjectIndexer.pas index 4370f54..d4f5f90 100644 --- a/Source/DelphiAST.ProjectIndexer.pas +++ b/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); diff --git a/Source/DelphiAST.pas b/Source/DelphiAST.pas index 92e77ab..cfe9163 100644 --- a/Source/DelphiAST.pas +++ b/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; 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; diff --git a/Test/Snippets/libraryrootnode.dpr b/Test/Snippets/libraryrootnode.dpr new file mode 100644 index 0000000..d21e249 --- /dev/null +++ b/Test/Snippets/libraryrootnode.dpr @@ -0,0 +1,5 @@ +library libraryrootnode; + +begin + +end. diff --git a/Test/Snippets/packagerootnode.dpk b/Test/Snippets/packagerootnode.dpk new file mode 100644 index 0000000..a681b8a --- /dev/null +++ b/Test/Snippets/packagerootnode.dpk @@ -0,0 +1,4 @@ +package packagerootnode; + + +end. diff --git a/Test/Snippets/programmrootnode.dpr b/Test/Snippets/programmrootnode.dpr new file mode 100644 index 0000000..2fe6ab2 --- /dev/null +++ b/Test/Snippets/programmrootnode.dpr @@ -0,0 +1,5 @@ +program programmrootnode; + +begin + +end. diff --git a/Test/uMainForm.pas b/Test/uMainForm.pas index 0c9b927..eacb630 100644 --- a/Test/uMainForm.pas +++ b/Test/uMainForm.pas @@ -47,6 +47,7 @@ procedure TForm2.btnRunClick(Sender: TObject); var Path, FileName: string; SyntaxTree: TSyntaxNode; + FileNames : TArray; begin memLog.Clear; @@ -54,7 +55,21 @@ procedure TForm2.btnRunClick(Sender: TObject); 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));