From fe3a779de6a359bdde556706cf71e03b1d00e327 Mon Sep 17 00:00:00 2001 From: JBontes Date: Thu, 24 Mar 2016 19:30:04 +0200 Subject: [PATCH 1/6] Improved diagnostics Added text to all asserts so it's clear what the error is. Changed the test do that it shows which file is being tested. --- Source/DelphiAST.Classes.pas | 4 +- Source/DelphiAST.pas | 13 +- .../__recovery/SimpleParser.Lexer.Types.pas | 318 ++++++++++++++++++ Source/SimpleParser/__recovery/__recovery.ini | 4 + Test/DelphiASTTest.res | Bin 1196 -> 1308 bytes Test/uMainForm.pas | 12 +- 6 files changed, 342 insertions(+), 9 deletions(-) create mode 100644 Source/SimpleParser/__recovery/SimpleParser.Lexer.Types.pas create mode 100644 Source/SimpleParser/__recovery/__recovery.ini diff --git a/Source/DelphiAST.Classes.pas b/Source/DelphiAST.Classes.pas index fbccda28..54956607 100644 --- a/Source/DelphiAST.Classes.pas +++ b/Source/DelphiAST.Classes.pas @@ -272,7 +272,7 @@ class procedure TExpressionTools.NodeListToTree(Expr: TList; Root: Root.AddChild(Stack.Pop); - Assert(Stack.Count = 0); + Assert(Stack.Count = 0,Format('TExpressionTools.NodeListToTree: stack should be 0, but is %d',[Stack.Count])); finally Stack.Free; end; @@ -391,7 +391,7 @@ function TSyntaxNode.TryGetAttributeEntry(const Key: TAttributeName; var Attribu function TSyntaxNode.AddChild(Node: TSyntaxNode): TSyntaxNode; begin - Assert(Assigned(Node)); + Assert(Assigned(Node),'TSyntaxNode.AddChild: Node is not assigned'); SetLength(FChildNodes, Length(FChildNodes) + 1); FChildNodes[Length(FChildNodes) - 1] := Node; diff --git a/Source/DelphiAST.pas b/Source/DelphiAST.pas index 79071c66..7c091512 100644 --- a/Source/DelphiAST.pas +++ b/Source/DelphiAST.pas @@ -56,10 +56,11 @@ TPasSyntaxTreeBuilder = class(TmwSimplePasPar) procedure CallInheritedExpression; procedure SetCurrentCompoundNodesEndPosition; procedure DoOnComment(Sender: TObject; const Text: string); + procedure SetUnitFilename(const Value: string); protected FStack: TNodeStack; FComments: TObjectList; - + FUnitFilename: string; //Full path of the unit, used to resolve inc filenames. procedure AccessSpecifier; override; procedure AdditiveOperator; override; procedure AddressOp; override; @@ -229,6 +230,7 @@ TPasSyntaxTreeBuilder = class(TmwSimplePasPar) procedure NamedArgument; override; procedure AttributeArgumentName; override; procedure AttributeArgumentExpression; override; + property UnitFileName: string read FUnitFilename write SetUnitFilename; public constructor Create; override; destructor Destroy; override; @@ -1818,6 +1820,7 @@ class function TPasSyntaxTreeBuilder.Run(const FileName: string; try Stream.LoadFromFile(FileName); Builder := TPasSyntaxTreeBuilder.Create; + Builder.UnitFilename:= Filename; Builder.InterfaceOnly := InterfaceOnly; try Builder.InitDefinesDefinedByCompiler; @@ -1853,7 +1856,7 @@ function TPasSyntaxTreeBuilder.Run(SourceStream: TStream): TSyntaxNode; raise; end; - Assert(FStack.Count = 0); + Assert(FStack.Count = 0, Format('TPasSyntaxTreeBuilder.Run: Stack.count should be 0, but is %d',[FStack.Count])); end; function TPasSyntaxTreeBuilder.NodeListToString(NamesNode: TSyntaxNode): string; @@ -1889,6 +1892,12 @@ procedure TPasSyntaxTreeBuilder.SetElement; end; end; +procedure TPasSyntaxTreeBuilder.SetUnitFilename(const Value: string); +begin + Assert(FUnitFilename = '','The filename can only be set once'); + FUnitFilename := Value; +end; + procedure TPasSyntaxTreeBuilder.SimpleStatement; var RawStatement, Temp: TSyntaxNode; diff --git a/Source/SimpleParser/__recovery/SimpleParser.Lexer.Types.pas b/Source/SimpleParser/__recovery/SimpleParser.Lexer.Types.pas new file mode 100644 index 00000000..3f9082ac --- /dev/null +++ b/Source/SimpleParser/__recovery/SimpleParser.Lexer.Types.pas @@ -0,0 +1,318 @@ +{--------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License Version +1.1 (the "License"); you may not use this file except in compliance with the +License. You may obtain a copy of the License at +http://www.mozilla.org/NPL/NPL-1_1Final.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: mwPasLexTypes, released November 14, 1999. + +The Initial Developer of the Original Code is Martin Waldenburg +unit CastaliaPasLexTypes; + +----------------------------------------------------------------------------} + +unit SimpleParser.Lexer.Types; + +interface + +uses + SysUtils, + TypInfo; + +{$INCLUDE SimpleParser.inc} + +var + CompTable: array[#0..#255] of byte; + +type + TMessageEventType = (meError, meNotSupported); + + TMessageEvent = procedure(Sender: TObject; const Typ: TMessageEventType; + const Msg: string; X, Y: Integer) of object; + + TCommentState = (csAnsi, csBor, csNo); + + TTokenPoint = packed record + X: Integer; + Y: Integer; + end; + + TptTokenKind = ( + ptAbort, + ptAbsolute, + ptAbstract, + ptAdd, + ptAddressOp, + ptAmpersand, + ptAnd, + ptAnsiComment, + ptAnsiString, + ptArray, + ptAs, + ptAsciiChar, + ptAsm, + ptAssembler, + ptAssign, + ptAt, + ptAutomated, + ptBegin, + ptBoolean, + ptBorComment, + ptBraceClose, + ptBraceOpen, + ptBreak, + ptByte, + ptByteBool, + ptCardinal, + ptCase, + ptCdecl, + ptChar, + ptClass, + ptClassForward, + ptClassFunction, + ptClassProcedure, + ptColon, + ptComma, + ptComp, + ptCompDirect, + ptConst, + ptConstructor, + ptContains, + ptContinue, + ptCRLF, + ptCRLFCo, + ptCurrency, + ptDefault, + ptDefineDirect, + ptDeprecated, + ptDestructor, + ptDispid, + ptDispinterface, + ptDiv, + ptDo, + ptDotDot, + ptDouble, + ptDoubleAddressOp, + ptDownto, + ptDWORD, + ptDynamic, + ptElse, + ptElseDirect, + ptEnd, + ptEndIfDirect, + ptEqual, + ptError, + ptExcept, + ptExit, + ptExport, + ptExports, + ptExtended, + ptExternal, + ptFar, + ptFile, + ptFinal, + ptExperimental, + ptDelayed, + ptFinalization, + ptFinally, + ptFloat, + ptFor, + ptForward, + ptFunction, + ptGoto, + ptGreater, + ptGreaterEqual, + ptHalt, + ptHelper, + ptIdentifier, + ptIf, + ptIfDirect, + ptIfEndDirect, + ptElseIfDirect, + ptIfDefDirect, + ptIfNDefDirect, + ptIfOptDirect, + ptImplementation, + ptImplements, + ptIn, + ptIncludeDirect, + ptIndex, + ptInherited, + ptInitialization, + ptInline, + ptInt64, + ptInteger, + ptIntegerConst, + ptInterface, + ptIs, + ptLabel, + ptLibrary, + ptLocal, + ptLongBool, + ptLongint, + ptLongword, + ptLower, + ptLowerEqual, + ptMessage, + ptMinus, + ptMod, + ptName, + ptNear, + ptNil, + ptNodefault, + ptNone, + ptNot, + ptNotEqual, + ptNull, + ptObject, + ptOf, + ptOleVariant, + ptOn, + ptOperator, + ptOr, + ptOut, + ptOverload, + ptOverride, + ptPackage, + ptPacked, + ptPascal, + ptPChar, + ptPlatform, + ptPlus, + ptPoint, + ptPointerSymbol, + ptPrivate, + ptProcedure, + ptProgram, + ptProperty, + ptProtected, + ptPublic, + ptPublished, + ptRaise, + ptRead, + ptReadonly, + ptReal, + ptReal48, + ptRecord, + ptReference, + ptRegister, + ptReintroduce, + ptRemove, + ptRepeat, + ptRequires, + ptResident, + ptResourceDirect, + ptResourcestring, + ptRoundClose, + ptRoundOpen, + ptRunError, + ptSafeCall, + ptSealed, + ptSemiColon, + ptSet, + ptShl, + ptShortint, + ptShortString, + ptShr, + ptSingle, + ptSlash, + ptSlashesComment, + ptSmallint, + ptSpace, + ptSquareClose, + ptSquareOpen, + ptStar, + ptStatic, + ptStdcall, + ptStored, + ptStrict, + ptString, + ptStringConst, + ptStringDQConst, + ptStringresource, + ptSymbol, + ptThen, + ptThreadvar, + ptTo, + ptTry, + ptType, + ptUndefDirect, + ptUnit, + ptUnknown, + ptUnsafe, + ptUntil, + ptUses, + ptVar, + ptVarargs, + ptVariant, + ptVirtual, + ptWhile, + ptWideChar, + ptWideString, + ptWith, + ptWord, + ptWordBool, + ptWrite, + ptWriteonly, + ptXor); + + TmwPasLexStatus = record + CommentState: TCommentState; + ExID: TptTokenKind; + LineNumber: Integer; + LinePos: Integer; + Origin: PChar; + RunPos: Integer; + TokenPos: Integer; + TokenID: TptTokenKind; + end; + + EIncludeError = class(Exception); + IIncludeHandler = interface + ['{C5F20740-41D2-43E9-8321-7FE5E3AA83B6}'] + function GetIncludeFileContent(const FileName: string; const pathname: string = ''): string; + end; + +function TokenName(Value: TptTokenKind): string; +function ptTokenName(Value: TptTokenKind): string; +function IsTokenIDJunk(const aTokenID: TptTokenKind): Boolean; + +implementation + +function TokenName(Value: TptTokenKind): string; +begin + Result := Copy(ptTokenName(Value), 3, MaxInt); +end; + +function ptTokenName(Value: TptTokenKind): string; +begin + result := GetEnumName(TypeInfo(TptTokenKind), Integer(Value)); +end; + +function IsTokenIDJunk(const aTokenID: TptTokenKind): Boolean; +begin + Result := aTokenID in [ + ptAnsiComment, + ptBorComment, + ptCRLF, + ptCRLFCo, + ptSlashesComment, + ptSpace, + ptIfDirect, + ptElseDirect, + ptIfEndDirect, + ptElseIfDirect, + ptIfDefDirect, + ptIfNDefDirect, + ptEndIfDirect, + ptIfOptDirect, + ptDefineDirect, + ptUndefDirect]; +end; + +end. + diff --git a/Source/SimpleParser/__recovery/__recovery.ini b/Source/SimpleParser/__recovery/__recovery.ini new file mode 100644 index 00000000..058e103a --- /dev/null +++ b/Source/SimpleParser/__recovery/__recovery.ini @@ -0,0 +1,4 @@ +[SimpleParser.Lexer.Types.pas] +SaveTime=24-3-2016 19:25:46 +FileCount=1 +File0=C:\borland\DelphiAST\Source\SimpleParser\SimpleParser.Lexer.Types.pas diff --git a/Test/DelphiASTTest.res b/Test/DelphiASTTest.res index 7b0f1a2625d5b44a1fec06c2d329238baba01942..fafddf63d5df9feb5024e570f67ea611e03addd8 100644 GIT binary patch delta 316 zcmZ3(IfrY40^@{7#NHg3>XX<%oucmv@wu0VlZJ)0E$>JSONK_ zK+=@KVzMQpJLAjAjf@L;6e@Ca@`|kzi*w72C+9G$Y4CC>DA=T=7Nq8-q~;}8+5x#p z0ws>c#i_YTIhA&keV8Of!IB^aC6xuKwo2uhdB#RcldG8wC$D9antXyu3!x$>F)zI| zF&(H%OKCDEv&v*WX35DO%pUv@3yM>dON%l~faWe_mYKYdS#k0MApMtFcCs{!yZ}Uv OK0=WXi^Ak=7DoWb;!$=0 delta 382 zcmbQkwT5$o0;9u3MR_3MXw1kku~eOL!Nj@Bj5QMvIx`wfW@R*=+{5U?cxv)R#syJ! zyj%(jHYuqEsd*`>dC8SvK9Wd@V{vh6Zc+|R0w|RT74ZaWD9J3T1epKPmQp-|v5Kd80$N>r1DkT Date: Thu, 24 Mar 2016 19:34:36 +0200 Subject: [PATCH 2/6] Delete SimpleParser.Lexer.Types.pas --- .../__recovery/SimpleParser.Lexer.Types.pas | 318 ------------------ 1 file changed, 318 deletions(-) delete mode 100644 Source/SimpleParser/__recovery/SimpleParser.Lexer.Types.pas diff --git a/Source/SimpleParser/__recovery/SimpleParser.Lexer.Types.pas b/Source/SimpleParser/__recovery/SimpleParser.Lexer.Types.pas deleted file mode 100644 index 3f9082ac..00000000 --- a/Source/SimpleParser/__recovery/SimpleParser.Lexer.Types.pas +++ /dev/null @@ -1,318 +0,0 @@ -{--------------------------------------------------------------------------- -The contents of this file are subject to the Mozilla Public License Version -1.1 (the "License"); you may not use this file except in compliance with the -License. You may obtain a copy of the License at -http://www.mozilla.org/NPL/NPL-1_1Final.html - -Software distributed under the License is distributed on an "AS IS" basis, -WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for -the specific language governing rights and limitations under the License. - -The Original Code is: mwPasLexTypes, released November 14, 1999. - -The Initial Developer of the Original Code is Martin Waldenburg -unit CastaliaPasLexTypes; - -----------------------------------------------------------------------------} - -unit SimpleParser.Lexer.Types; - -interface - -uses - SysUtils, - TypInfo; - -{$INCLUDE SimpleParser.inc} - -var - CompTable: array[#0..#255] of byte; - -type - TMessageEventType = (meError, meNotSupported); - - TMessageEvent = procedure(Sender: TObject; const Typ: TMessageEventType; - const Msg: string; X, Y: Integer) of object; - - TCommentState = (csAnsi, csBor, csNo); - - TTokenPoint = packed record - X: Integer; - Y: Integer; - end; - - TptTokenKind = ( - ptAbort, - ptAbsolute, - ptAbstract, - ptAdd, - ptAddressOp, - ptAmpersand, - ptAnd, - ptAnsiComment, - ptAnsiString, - ptArray, - ptAs, - ptAsciiChar, - ptAsm, - ptAssembler, - ptAssign, - ptAt, - ptAutomated, - ptBegin, - ptBoolean, - ptBorComment, - ptBraceClose, - ptBraceOpen, - ptBreak, - ptByte, - ptByteBool, - ptCardinal, - ptCase, - ptCdecl, - ptChar, - ptClass, - ptClassForward, - ptClassFunction, - ptClassProcedure, - ptColon, - ptComma, - ptComp, - ptCompDirect, - ptConst, - ptConstructor, - ptContains, - ptContinue, - ptCRLF, - ptCRLFCo, - ptCurrency, - ptDefault, - ptDefineDirect, - ptDeprecated, - ptDestructor, - ptDispid, - ptDispinterface, - ptDiv, - ptDo, - ptDotDot, - ptDouble, - ptDoubleAddressOp, - ptDownto, - ptDWORD, - ptDynamic, - ptElse, - ptElseDirect, - ptEnd, - ptEndIfDirect, - ptEqual, - ptError, - ptExcept, - ptExit, - ptExport, - ptExports, - ptExtended, - ptExternal, - ptFar, - ptFile, - ptFinal, - ptExperimental, - ptDelayed, - ptFinalization, - ptFinally, - ptFloat, - ptFor, - ptForward, - ptFunction, - ptGoto, - ptGreater, - ptGreaterEqual, - ptHalt, - ptHelper, - ptIdentifier, - ptIf, - ptIfDirect, - ptIfEndDirect, - ptElseIfDirect, - ptIfDefDirect, - ptIfNDefDirect, - ptIfOptDirect, - ptImplementation, - ptImplements, - ptIn, - ptIncludeDirect, - ptIndex, - ptInherited, - ptInitialization, - ptInline, - ptInt64, - ptInteger, - ptIntegerConst, - ptInterface, - ptIs, - ptLabel, - ptLibrary, - ptLocal, - ptLongBool, - ptLongint, - ptLongword, - ptLower, - ptLowerEqual, - ptMessage, - ptMinus, - ptMod, - ptName, - ptNear, - ptNil, - ptNodefault, - ptNone, - ptNot, - ptNotEqual, - ptNull, - ptObject, - ptOf, - ptOleVariant, - ptOn, - ptOperator, - ptOr, - ptOut, - ptOverload, - ptOverride, - ptPackage, - ptPacked, - ptPascal, - ptPChar, - ptPlatform, - ptPlus, - ptPoint, - ptPointerSymbol, - ptPrivate, - ptProcedure, - ptProgram, - ptProperty, - ptProtected, - ptPublic, - ptPublished, - ptRaise, - ptRead, - ptReadonly, - ptReal, - ptReal48, - ptRecord, - ptReference, - ptRegister, - ptReintroduce, - ptRemove, - ptRepeat, - ptRequires, - ptResident, - ptResourceDirect, - ptResourcestring, - ptRoundClose, - ptRoundOpen, - ptRunError, - ptSafeCall, - ptSealed, - ptSemiColon, - ptSet, - ptShl, - ptShortint, - ptShortString, - ptShr, - ptSingle, - ptSlash, - ptSlashesComment, - ptSmallint, - ptSpace, - ptSquareClose, - ptSquareOpen, - ptStar, - ptStatic, - ptStdcall, - ptStored, - ptStrict, - ptString, - ptStringConst, - ptStringDQConst, - ptStringresource, - ptSymbol, - ptThen, - ptThreadvar, - ptTo, - ptTry, - ptType, - ptUndefDirect, - ptUnit, - ptUnknown, - ptUnsafe, - ptUntil, - ptUses, - ptVar, - ptVarargs, - ptVariant, - ptVirtual, - ptWhile, - ptWideChar, - ptWideString, - ptWith, - ptWord, - ptWordBool, - ptWrite, - ptWriteonly, - ptXor); - - TmwPasLexStatus = record - CommentState: TCommentState; - ExID: TptTokenKind; - LineNumber: Integer; - LinePos: Integer; - Origin: PChar; - RunPos: Integer; - TokenPos: Integer; - TokenID: TptTokenKind; - end; - - EIncludeError = class(Exception); - IIncludeHandler = interface - ['{C5F20740-41D2-43E9-8321-7FE5E3AA83B6}'] - function GetIncludeFileContent(const FileName: string; const pathname: string = ''): string; - end; - -function TokenName(Value: TptTokenKind): string; -function ptTokenName(Value: TptTokenKind): string; -function IsTokenIDJunk(const aTokenID: TptTokenKind): Boolean; - -implementation - -function TokenName(Value: TptTokenKind): string; -begin - Result := Copy(ptTokenName(Value), 3, MaxInt); -end; - -function ptTokenName(Value: TptTokenKind): string; -begin - result := GetEnumName(TypeInfo(TptTokenKind), Integer(Value)); -end; - -function IsTokenIDJunk(const aTokenID: TptTokenKind): Boolean; -begin - Result := aTokenID in [ - ptAnsiComment, - ptBorComment, - ptCRLF, - ptCRLFCo, - ptSlashesComment, - ptSpace, - ptIfDirect, - ptElseDirect, - ptIfEndDirect, - ptElseIfDirect, - ptIfDefDirect, - ptIfNDefDirect, - ptEndIfDirect, - ptIfOptDirect, - ptDefineDirect, - ptUndefDirect]; -end; - -end. - From 5888c2b8b0a1d4134b53aa19731d35b52c2adcec Mon Sep 17 00:00:00 2001 From: JBontes Date: Thu, 24 Mar 2016 19:34:51 +0200 Subject: [PATCH 3/6] Delete __recovery.ini --- Source/SimpleParser/__recovery/__recovery.ini | 4 ---- 1 file changed, 4 deletions(-) delete mode 100644 Source/SimpleParser/__recovery/__recovery.ini diff --git a/Source/SimpleParser/__recovery/__recovery.ini b/Source/SimpleParser/__recovery/__recovery.ini deleted file mode 100644 index 058e103a..00000000 --- a/Source/SimpleParser/__recovery/__recovery.ini +++ /dev/null @@ -1,4 +0,0 @@ -[SimpleParser.Lexer.Types.pas] -SaveTime=24-3-2016 19:25:46 -FileCount=1 -File0=C:\borland\DelphiAST\Source\SimpleParser\SimpleParser.Lexer.Types.pas From 7858ddd5272fae3df90a96ecc4f63361de5204ee Mon Sep 17 00:00:00 2001 From: JBontes Date: Thu, 24 Mar 2016 21:50:44 +0200 Subject: [PATCH 4/6] Correctly proces inc files in test Correctly proces inc files in test Use the default fileopen box (with folders) so you can copy-paste a path. (The selectdir call sucks so bad!). --- Test/uMainForm.dfm | 7 +++++++ Test/uMainForm.pas | 13 ++++++++++--- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/Test/uMainForm.dfm b/Test/uMainForm.dfm index 36ad39d2..1554b3fb 100644 --- a/Test/uMainForm.dfm +++ b/Test/uMainForm.dfm @@ -40,4 +40,11 @@ object Form2: TForm2 TabOrder = 1 OnClick = btnRunClick end + object FileOpenDialog1: TFileOpenDialog + FavoriteLinks = <> + FileTypes = <> + Options = [fdoPickFolders, fdoPathMustExist, fdoDontAddToRecent, fdoForceShowHidden] + Left = 400 + Top = 200 + end end diff --git a/Test/uMainForm.pas b/Test/uMainForm.pas index 3ce8301f..96b07204 100644 --- a/Test/uMainForm.pas +++ b/Test/uMainForm.pas @@ -17,6 +17,7 @@ interface TForm2 = class(TForm) memLog: TMemo; btnRun: TButton; + FileOpenDialog1: TFileOpenDialog; procedure btnRunClick(Sender: TObject); private { Private declarations } @@ -47,18 +48,24 @@ procedure TForm2.btnRunClick(Sender: TObject); Path, FileName: string; SyntaxTree: TSyntaxNode; LineNumber: integer; + FilePath: string; begin memLog.Clear; Path := ExtractFilePath(Application.ExeName) + 'Snippets\'; - if not SelectDirectory('Select Folder', '', Path) then - Exit; + FileOpenDialog1.DefaultFolder:= Path; + if not(FileOpenDialog1.Execute) then Exit; + Path:= FileOpenDialog1.FileName; + + //if not SelectDirectory('Select Folder', '', Path) then + // Exit; for FileName in TDirectory.GetFiles(Path, '*.pas', TSearchOption.soAllDirectories) do begin try LineNumber := memlog.Lines.Add('Testing:' + FileName); - SyntaxTree := TPasSyntaxTreeBuilder.Run(FileName, False, TIncludeHandler.Create(Path)); + FilePath:= TPath.GetDirectoryName(Filename); + SyntaxTree := TPasSyntaxTreeBuilder.Run(FileName, False, TIncludeHandler.Create(FilePath)); try memLog.Lines[LineNumber]:= 'OK: ' + FileName; finally From 88229c71d764b5dd407e2d7ffc28761bcf4bb035 Mon Sep 17 00:00:00 2001 From: JBontes Date: Sat, 26 Mar 2016 15:36:21 +0200 Subject: [PATCH 5/6] The ; is optional with forward Fixed ; handling with forward When forward is used in the implementation add the `forward` attribute to the proc. Fixed the test so that all test cases are included. --- Source/DelphiAST.pas | 9 +++++++++ Source/SimpleParser/SimpleParser.pas | 4 +++- Test/Snippets/forwardwithoutsemicolon.pas | 18 +++++++++++++----- 3 files changed, 25 insertions(+), 6 deletions(-) diff --git a/Source/DelphiAST.pas b/Source/DelphiAST.pas index 7c091512..4c19dc3c 100644 --- a/Source/DelphiAST.pas +++ b/Source/DelphiAST.pas @@ -132,6 +132,7 @@ TPasSyntaxTreeBuilder = class(TmwSimplePasPar) procedure ForStatementFrom; override; procedure ForStatementIn; override; procedure ForStatementTo; override; + procedure ForwardDeclaration; override; procedure FunctionHeading; override; procedure FunctionMethodName; override; procedure FunctionProcedureName; override; @@ -1236,6 +1237,14 @@ procedure TPasSyntaxTreeBuilder.ForStatementTo; end; end; +procedure TPasSyntaxTreeBuilder.ForwardDeclaration; +begin + if FStack.Peek.ParentNode.Typ = ntImplementation then begin + FStack.Peek.SetAttribute(anForwarded, 'true'); + end; + inherited; +end; + procedure TPasSyntaxTreeBuilder.FunctionHeading; begin FStack.Peek.SetAttribute(anKind, 'function'); diff --git a/Source/SimpleParser/SimpleParser.pas b/Source/SimpleParser/SimpleParser.pas index 04642a61..d27948d5 100644 --- a/Source/SimpleParser/SimpleParser.pas +++ b/Source/SimpleParser/SimpleParser.pas @@ -614,8 +614,10 @@ constructor ESyntaxError.CreatePos(const Msg: string; aPosXY: TTokenPoint); procedure TmwSimplePasPar.ForwardDeclaration; begin + //semicolon is optional after forward directive. NextToken; - Semicolon; + if TokenID = ptSemiColon then NextToken; + //Semicolon; end; procedure TmwSimplePasPar.ObjectProperty; diff --git a/Test/Snippets/forwardwithoutsemicolon.pas b/Test/Snippets/forwardwithoutsemicolon.pas index 712c8f3f..58b01acb 100644 --- a/Test/Snippets/forwardwithoutsemicolon.pas +++ b/Test/Snippets/forwardwithoutsemicolon.pas @@ -2,18 +2,26 @@ interface -procedure proc1(); forward // NO TRAILING SEMICOLON -procedure proc2(); +procedure proc1(); forward; +procedure proc2(); forward // NO TRAILING SEMICOLON implementation -procedure proc1(); -begin +procedure proc3(); forward // NO TRAILING SEMICOLON + +procedure proc1(); +begin + proc3; end; procedure proc2(); -begin +begin + +end; + +procedure proc3(); +begin end; From 432fd2508542c56a5f30e85c64f8ba7ee69e2662 Mon Sep 17 00:00:00 2001 From: JBontes Date: Mon, 4 Apr 2016 15:13:41 +0200 Subject: [PATCH 6/6] Sync with Roman's version --- Demo/uMainForm.pas | 6 ++ Source/DelphiAST.Classes.pas | 4 +- Source/DelphiAST.pas | 22 +----- Source/SimpleParser/SimpleParser.pas | 81 ++++++---------------- Test/DelphiASTTest.res | Bin 1308 -> 1196 bytes Test/Snippets/DeprecatedOnConst.pas | 11 +++ Test/Snippets/forwardwithoutsemicolon.pas | 18 ++--- Test/uMainForm.dfm | 8 +-- Test/uMainForm.pas | 25 +++---- 9 files changed, 55 insertions(+), 120 deletions(-) create mode 100644 Test/Snippets/DeprecatedOnConst.pas diff --git a/Demo/uMainForm.pas b/Demo/uMainForm.pas index a4b315d8..e0546199 100644 --- a/Demo/uMainForm.pas +++ b/Demo/uMainForm.pas @@ -82,6 +82,12 @@ function TIncludeHandler.GetIncludeFileContent(const FileName: string): string; begin FileContent := TStringList.Create; try + if not FileExists(TPath.Combine(FPath, FileName)) then + begin + Result := ''; + Exit; + end; + FileContent.LoadFromFile(TPath.Combine(FPath, FileName)); Result := FileContent.Text; finally diff --git a/Source/DelphiAST.Classes.pas b/Source/DelphiAST.Classes.pas index 54956607..fbccda28 100644 --- a/Source/DelphiAST.Classes.pas +++ b/Source/DelphiAST.Classes.pas @@ -272,7 +272,7 @@ class procedure TExpressionTools.NodeListToTree(Expr: TList; Root: Root.AddChild(Stack.Pop); - Assert(Stack.Count = 0,Format('TExpressionTools.NodeListToTree: stack should be 0, but is %d',[Stack.Count])); + Assert(Stack.Count = 0); finally Stack.Free; end; @@ -391,7 +391,7 @@ function TSyntaxNode.TryGetAttributeEntry(const Key: TAttributeName; var Attribu function TSyntaxNode.AddChild(Node: TSyntaxNode): TSyntaxNode; begin - Assert(Assigned(Node),'TSyntaxNode.AddChild: Node is not assigned'); + Assert(Assigned(Node)); SetLength(FChildNodes, Length(FChildNodes) + 1); FChildNodes[Length(FChildNodes) - 1] := Node; diff --git a/Source/DelphiAST.pas b/Source/DelphiAST.pas index 4c19dc3c..79071c66 100644 --- a/Source/DelphiAST.pas +++ b/Source/DelphiAST.pas @@ -56,11 +56,10 @@ TPasSyntaxTreeBuilder = class(TmwSimplePasPar) procedure CallInheritedExpression; procedure SetCurrentCompoundNodesEndPosition; procedure DoOnComment(Sender: TObject; const Text: string); - procedure SetUnitFilename(const Value: string); protected FStack: TNodeStack; FComments: TObjectList; - FUnitFilename: string; //Full path of the unit, used to resolve inc filenames. + procedure AccessSpecifier; override; procedure AdditiveOperator; override; procedure AddressOp; override; @@ -132,7 +131,6 @@ TPasSyntaxTreeBuilder = class(TmwSimplePasPar) procedure ForStatementFrom; override; procedure ForStatementIn; override; procedure ForStatementTo; override; - procedure ForwardDeclaration; override; procedure FunctionHeading; override; procedure FunctionMethodName; override; procedure FunctionProcedureName; override; @@ -231,7 +229,6 @@ TPasSyntaxTreeBuilder = class(TmwSimplePasPar) procedure NamedArgument; override; procedure AttributeArgumentName; override; procedure AttributeArgumentExpression; override; - property UnitFileName: string read FUnitFilename write SetUnitFilename; public constructor Create; override; destructor Destroy; override; @@ -1237,14 +1234,6 @@ procedure TPasSyntaxTreeBuilder.ForStatementTo; end; end; -procedure TPasSyntaxTreeBuilder.ForwardDeclaration; -begin - if FStack.Peek.ParentNode.Typ = ntImplementation then begin - FStack.Peek.SetAttribute(anForwarded, 'true'); - end; - inherited; -end; - procedure TPasSyntaxTreeBuilder.FunctionHeading; begin FStack.Peek.SetAttribute(anKind, 'function'); @@ -1829,7 +1818,6 @@ class function TPasSyntaxTreeBuilder.Run(const FileName: string; try Stream.LoadFromFile(FileName); Builder := TPasSyntaxTreeBuilder.Create; - Builder.UnitFilename:= Filename; Builder.InterfaceOnly := InterfaceOnly; try Builder.InitDefinesDefinedByCompiler; @@ -1865,7 +1853,7 @@ function TPasSyntaxTreeBuilder.Run(SourceStream: TStream): TSyntaxNode; raise; end; - Assert(FStack.Count = 0, Format('TPasSyntaxTreeBuilder.Run: Stack.count should be 0, but is %d',[FStack.Count])); + Assert(FStack.Count = 0); end; function TPasSyntaxTreeBuilder.NodeListToString(NamesNode: TSyntaxNode): string; @@ -1901,12 +1889,6 @@ procedure TPasSyntaxTreeBuilder.SetElement; end; end; -procedure TPasSyntaxTreeBuilder.SetUnitFilename(const Value: string); -begin - Assert(FUnitFilename = '','The filename can only be set once'); - FUnitFilename := Value; -end; - procedure TPasSyntaxTreeBuilder.SimpleStatement; var RawStatement, Temp: TSyntaxNode; diff --git a/Source/SimpleParser/SimpleParser.pas b/Source/SimpleParser/SimpleParser.pas index d27948d5..b17b10b6 100644 --- a/Source/SimpleParser/SimpleParser.pas +++ b/Source/SimpleParser/SimpleParser.pas @@ -614,10 +614,8 @@ constructor ESyntaxError.CreatePos(const Msg: string; aPosXY: TTokenPoint); procedure TmwSimplePasPar.ForwardDeclaration; begin - //semicolon is optional after forward directive. NextToken; - if TokenID = ptSemiColon then NextToken; - //Semicolon; + Semicolon; end; procedure TmwSimplePasPar.ObjectProperty; @@ -1154,13 +1152,7 @@ procedure TmwSimplePasPar.UnitFile; begin Expected(ptUnit); UnitName; - while ExID in [ptDeprecated, ptLibrary, ptPlatform, ptExperimental] do - case ExID of - ptDeprecated: DirectiveDeprecated; - ptLibrary: DirectiveLibrary; - ptPlatform: DirectivePlatform; - ptExperimental: NextToken; - end; + TypeDirective; Semicolon; InterfaceSection; @@ -3092,12 +3084,8 @@ procedure TmwSimplePasPar.VarDeclaration; VarNameList; Expected(ptColon); TypeKind; - while ExID in [ptDeprecated, ptLibrary, ptPlatform] do - case ExID of - ptDeprecated: DirectiveDeprecated; - ptLibrary: DirectiveLibrary; - ptPlatform: DirectivePlatform; - end; + TypeDirective; + case GenID of ptAbsolute: begin @@ -3108,12 +3096,7 @@ procedure TmwSimplePasPar.VarDeclaration; VarEqual; end; end; - while ExID in [ptDeprecated, ptLibrary, ptPlatform] do - case ExID of - ptDeprecated: DirectiveDeprecated; - ptLibrary: DirectiveLibrary; - ptPlatform: DirectivePlatform; - end; + TypeDirective; end; procedure TmwSimplePasPar.VarAbsolute; @@ -3234,12 +3217,7 @@ procedure TmwSimplePasPar.FieldDeclaration; FieldNameList; Expected(ptColon); TypeKind; - while ExID in [ptDeprecated, ptLibrary, ptPlatform] do - case ExID of - ptDeprecated: DirectiveDeprecated; - ptLibrary: DirectiveLibrary; - ptPlatform: DirectivePlatform; - end; + TypeDirective; end; procedure TmwSimplePasPar.FieldList; @@ -3970,12 +3948,7 @@ procedure TmwSimplePasPar.ClassField; FieldNameList; Expected(ptColon); TypeKind; - while ExID in [ptDeprecated, ptLibrary, ptPlatform] do - case ExID of - ptDeprecated: DirectiveDeprecated; - ptLibrary: DirectiveLibrary; - ptPlatform: DirectivePlatform; - end; + TypeDirective; end; procedure TmwSimplePasPar.ObjectType; @@ -4077,12 +4050,7 @@ procedure TmwSimplePasPar.ObjectField; IdentifierList; Expected(ptColon); TypeKind; - while ExID in [ptDeprecated, ptLibrary, ptPlatform] do - case ExID of - ptDeprecated: DirectiveDeprecated; - ptLibrary: DirectiveLibrary; - ptPlatform: DirectivePlatform; - end; + TypeDirective; end; procedure TmwSimplePasPar.ClassReferenceType; @@ -4630,12 +4598,7 @@ procedure TmwSimplePasPar.ResourceDeclaration; ResourceValue; - while ExID in [ptDeprecated, ptLibrary, ptPlatform] do - case ExID of - ptDeprecated: DirectiveDeprecated; - ptLibrary: DirectiveLibrary; - ptPlatform: DirectivePlatform; - end; + TypeDirective; end; procedure TmwSimplePasPar.ResourceValue; @@ -4665,12 +4628,7 @@ procedure TmwSimplePasPar.ConstantDeclaration; SynError(InvalidConstantDeclaration); end; end; - while ExID in [ptDeprecated, ptLibrary, ptPlatform] do - case ExID of - ptDeprecated: DirectiveDeprecated; - ptLibrary: DirectiveLibrary; - ptPlatform: DirectivePlatform; - end; + TypeDirective; end; procedure TmwSimplePasPar.ConstantColon; @@ -4778,7 +4736,7 @@ procedure TmwSimplePasPar.LabelDeclarationSection; procedure TmwSimplePasPar.ProceduralDirective; begin - case ExID of + case GenID of ptAbstract: begin DirectiveBinding; @@ -5259,9 +5217,9 @@ procedure TmwSimplePasPar.IdentifierList; procedure TmwSimplePasPar.CharString; begin - case TokenID of + case GenID of ptAsciiChar, ptIdentifier, ptRoundOpen, ptStringConst: - while TokenID in + while GenID in [ptAsciiChar, ptIdentifier, ptRoundOpen, ptStringConst, ptString] do begin case TokenID of @@ -5436,7 +5394,7 @@ procedure TmwSimplePasPar.DirectiveDeprecated; procedure TmwSimplePasPar.DirectiveLibrary; begin - ExpectedEx(ptLibrary); + Expected(ptLibrary); end; procedure TmwSimplePasPar.DirectivePlatform; @@ -5615,11 +5573,12 @@ procedure TmwSimplePasPar.ProceduralDirectiveOf; procedure TmwSimplePasPar.TypeDirective; begin - while ExID in [ptDeprecated, ptLibrary, ptPlatform] do - case ExID of - ptDeprecated: DirectiveDeprecated; - ptLibrary: DirectiveLibrary; - ptPlatform: DirectivePlatform; + while GenID in [ptDeprecated, ptLibrary, ptPlatform, ptExperimental] do + case GenID of + ptDeprecated: DirectiveDeprecated; + ptLibrary: DirectiveLibrary; + ptPlatform: DirectivePlatform; + ptExperimental: NextToken; end; end; diff --git a/Test/DelphiASTTest.res b/Test/DelphiASTTest.res index fafddf63d5df9feb5024e570f67ea611e03addd8..7b0f1a2625d5b44a1fec06c2d329238baba01942 100644 GIT binary patch delta 382 zcmbQkwT5$o0;9u3MR_3MXw1kku~eOL!Nj@Bj5QMvIx`wfW@R*=+{5U?cxv)R#syJ! zyj%(jHYuqEsd*`>dC8SvK9Wd@V{vh6Zc+|R0w|RT74ZaWD9J3T1epKPmQp-|v5Kd80$N>r1DkT7#NHg3>XX<%oucmv@wu0VlZJ)0E$>JSONK_ zK+=@KVzMQpJLAjAjf@L;6e@Ca@`|kzi*w72C+9G$Y4CC>DA=T=7Nq8-q~;}8+5x#p z0ws>c#i_YTIhA&keV8Of!IB^aC6xuKwo2uhdB#RcldG8wC$D9antXyu3!x$>F)zI| zF&(H%OKCDEv&v*WX35DO%pUv@3yM>dON%l~faWe_mYKYdS#k0MApMtFcCs{!yZ}Uv OK0=WXi^Ak=7DoWb;!$=0 diff --git a/Test/Snippets/DeprecatedOnConst.pas b/Test/Snippets/DeprecatedOnConst.pas new file mode 100644 index 00000000..8d27ffc5 --- /dev/null +++ b/Test/Snippets/DeprecatedOnConst.pas @@ -0,0 +1,11 @@ +unit DeprecatedOnConst; + +interface + +const + MyConst = 'test' deprecated 'Do not use'; + MyConst2 = 'test2' platform; + MyConst3 = 'test4' library; + +implementation +end. diff --git a/Test/Snippets/forwardwithoutsemicolon.pas b/Test/Snippets/forwardwithoutsemicolon.pas index 58b01acb..712c8f3f 100644 --- a/Test/Snippets/forwardwithoutsemicolon.pas +++ b/Test/Snippets/forwardwithoutsemicolon.pas @@ -2,26 +2,18 @@ interface -procedure proc1(); forward; -procedure proc2(); forward // NO TRAILING SEMICOLON +procedure proc1(); forward // NO TRAILING SEMICOLON +procedure proc2(); implementation - -procedure proc3(); forward // NO TRAILING SEMICOLON - -procedure proc1(); -begin - proc3; -end; - -procedure proc2(); +procedure proc1(); begin end; -procedure proc3(); -begin +procedure proc2(); +begin end; diff --git a/Test/uMainForm.dfm b/Test/uMainForm.dfm index 1554b3fb..6198193b 100644 --- a/Test/uMainForm.dfm +++ b/Test/uMainForm.dfm @@ -28,6 +28,7 @@ object Form2: TForm2 Font.Name = 'Lucida Console' Font.Style = [] ParentFont = False + ScrollBars = ssBoth TabOrder = 0 end object btnRun: TButton @@ -40,11 +41,4 @@ object Form2: TForm2 TabOrder = 1 OnClick = btnRunClick end - object FileOpenDialog1: TFileOpenDialog - FavoriteLinks = <> - FileTypes = <> - Options = [fdoPickFolders, fdoPathMustExist, fdoDontAddToRecent, fdoForceShowHidden] - Left = 400 - Top = 200 - end end diff --git a/Test/uMainForm.pas b/Test/uMainForm.pas index 96b07204..f36efb4a 100644 --- a/Test/uMainForm.pas +++ b/Test/uMainForm.pas @@ -17,7 +17,6 @@ interface TForm2 = class(TForm) memLog: TMemo; btnRun: TButton; - FileOpenDialog1: TFileOpenDialog; procedure btnRunClick(Sender: TObject); private { Private declarations } @@ -47,37 +46,29 @@ procedure TForm2.btnRunClick(Sender: TObject); var Path, FileName: string; SyntaxTree: TSyntaxNode; - LineNumber: integer; - FilePath: string; begin memLog.Clear; Path := ExtractFilePath(Application.ExeName) + 'Snippets\'; - FileOpenDialog1.DefaultFolder:= Path; - if not(FileOpenDialog1.Execute) then Exit; - Path:= FileOpenDialog1.FileName; - - //if not SelectDirectory('Select Folder', '', Path) then - // Exit; + if not SelectDirectory('Select Folder', '', Path) then + Exit; for FileName in TDirectory.GetFiles(Path, '*.pas', TSearchOption.soAllDirectories) do begin try - LineNumber := memlog.Lines.Add('Testing:' + FileName); - FilePath:= TPath.GetDirectoryName(Filename); - SyntaxTree := TPasSyntaxTreeBuilder.Run(FileName, False, TIncludeHandler.Create(FilePath)); + SyntaxTree := TPasSyntaxTreeBuilder.Run(FileName, False, TIncludeHandler.Create(Path)); try - memLog.Lines[LineNumber]:= 'OK: ' + FileName; + memLog.Lines.Add('OK: ' + FileName); finally SyntaxTree.Free; end; except on E: Exception do begin - memLog.Lines[Linenumber]:= 'FAILED: ' + FileName; - memLog.Lines.Add(' ' + E.ClassName); - memLog.Lines.Add(' ' + E.Message); - memLog.Repaint; + memLog.Lines.Add('FAILED: ' + FileName); + memLog.Lines.Add(' ' + E.ClassName); + memLog.Lines.Add(' ' + E.Message); + memLog.Repaint; end; end; end;