diff --git a/.github/workflows/fpc-tests.yml b/.github/workflows/fpc-tests.yml new file mode 100644 index 00000000..38abcc1e --- /dev/null +++ b/.github/workflows/fpc-tests.yml @@ -0,0 +1,38 @@ +name: FPC tests + +on: + push: + pull_request: + +permissions: + contents: read + +jobs: + test: + runs-on: ubuntu-latest + + steps: + - name: Check out repository + uses: actions/checkout@v4 + with: + submodules: recursive + + - name: Install Free Pascal + run: sudo apt-get update && sudo apt-get install --no-install-recommends fp-compiler fp-units-fcl + + - name: Compile tests + run: | + mkdir -p build/fpc-tests/units + fpc -B -Mdelphi \ + -FuSource \ + -FuSource/SimpleParser \ + -FiSource/SimpleParser \ + -FuSource/FreePascalSupport \ + -FuSource/FreePascalSupport/FPC_StringBuilder/Src \ + -FuTest/UnitTests \ + -FUbuild/fpc-tests/units \ + -FEbuild/fpc-tests \ + Test/UnitTests/DelphiASTTests.lpr + + - name: Run tests + run: build/fpc-tests/DelphiASTTests Test/Snippets diff --git a/README.md b/README.md index 225a1b6e..4fe12565 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -[![](https://tokei.rs/b1/github/jimmckeeth/DelphiAST?category=lines)](https://github.com/jimmckeeth/DelphiAST) [![](https://tokei.rs/b1/github/jimmckeeth/DelphiAST?category=code)](https://github.com/jimmckeeth/DelphiAST) [![](https://tokei.rs/b1/github/jimmckeeth/DelphiAST?category=files)](https://github.com/jimmckeeth/DelphiAST) +[![Total lines](https://www.aschey.tech/tokei/github/jimmckeeth/DelphiAST?category=lines)](https://github.com/jimmckeeth/DelphiAST) [![Lines of code](https://www.aschey.tech/tokei/github/jimmckeeth/DelphiAST?category=code)](https://github.com/jimmckeeth/DelphiAST) [![Source files](https://www.aschey.tech/tokei/github/jimmckeeth/DelphiAST?category=files)](https://github.com/jimmckeeth/DelphiAST) [![Tests: 41](https://img.shields.io/badge/tests-41-blue)](Tests) [![Test Workflow](https://github.com/jimmckeeth/DelphiAST/actions/workflows/fpc-tests.yml/badge.svg)](https://github.com/jimmckeeth/DelphiAST/actions/workflows/fpc-tests.yml) **Update:** This is a maintained fork of [Roman Yankovsky's original](https://github.com/RomanYankovsky/DelphiAST), intended to collect useful fixes from open upstream pull requests and active forks while upstream review is quiet. New pull requests are welcome [here](https://github.com/jimmckeeth/DelphiAST/pulls). @@ -22,6 +22,30 @@ With DelphiAST you can take real Delphi code and get an abstract syntax tree. On Compatible with [Delphi](https://www.embarcadero.com/products/delphi), [FreePascal](https://www.freepascal.org/), & [Lazarus](https://www.lazarus-ide.org/). +## Tests + +The headless suite runs the same shared tests with separate Delphi and FPC console +projects. It parses every file in `Test/Snippets` and performs focused assertions +against parser behavior, AST structure, error handling, source positions, and XML +output. + +With FPC installed, compile and run the suite from the repository root: + +```bash +mkdir -p build/fpc-tests/units +fpc -B -Mdelphi \ + -FuSource -FuSource/SimpleParser -FiSource/SimpleParser \ + -FuSource/FreePascalSupport \ + -FuSource/FreePascalSupport/FPC_StringBuilder/Src \ + -FuTest/UnitTests -FUbuild/fpc-tests/units -FEbuild/fpc-tests \ + Test/UnitTests/DelphiASTTests.lpr +build/fpc-tests/DelphiASTTests Test/Snippets +``` + +For Delphi, build `Test/UnitTests/DelphiASTTests.dproj` and pass the path to +`Test/Snippets` as the executable's first argument. The original interactive test +application remains available under `Test/GUI`. + ## Sample input ```delphi unit Unit1; diff --git a/Source/DelphiAST.Writer.pas b/Source/DelphiAST.Writer.pas index bf6978b4..e85b06ec 100644 --- a/Source/DelphiAST.Writer.pas +++ b/Source/DelphiAST.Writer.pas @@ -82,7 +82,7 @@ class procedure TSyntaxTreeWriter.NodeToXML(const Builder: TStringBuilder; NewIndent := Indent + ' '; Builder.Append(Indent); end; - Builder.Append('<' + UpperCase(SyntaxNodeNames[Node.Typ])); + Builder.Append('<' + UpperCase(SyntaxNodeNames.Items[Node.Typ])); Builder.Append(' line_seq="' + IntToStr(Node.LineSeq) + '"'); @@ -118,7 +118,7 @@ class procedure TSyntaxTreeWriter.NodeToXML(const Builder: TStringBuilder; begin if Formatted then Builder.Append(Indent); - Builder.Append(''); + Builder.Append(''); if Formatted then Builder.AppendLine; end; diff --git a/Source/SimpleParser/SimpleParser.pas b/Source/SimpleParser/SimpleParser.pas index 062705c5..06caf50d 100644 --- a/Source/SimpleParser/SimpleParser.pas +++ b/Source/SimpleParser/SimpleParser.pas @@ -721,7 +721,8 @@ function TStringStreamHelper.GetDataString: string; begin Encoding := nil; SetLength(Bytes, Self.Size); - Bytes := BytesOf(DataString); + if Self.Size > 0 then + Move(Self.Memory^, Bytes[0], Self.Size); TEncoding.GetBufferEncoding(Bytes, Encoding); Result := Encoding.GetString(Bytes, Length(Encoding.GetPreamble), Size); {$ENDIF} @@ -4441,10 +4442,10 @@ procedure TmwSimplePasPar.RecordAlign; if ExID = ptAlign then begin NextToken; - if TokenID = ptRoundOpen then - ConstantExpression + if TokenID = ptIntegerConst then + RecordAlignValue else - RecordAlignValue; + ConstantExpression; end; end; diff --git a/Test/DelphiASTTest.dpr b/Test/GUI/DelphiASTTest.dpr similarity index 68% rename from Test/DelphiASTTest.dpr rename to Test/GUI/DelphiASTTest.dpr index 60324f14..0012281f 100644 --- a/Test/DelphiASTTest.dpr +++ b/Test/GUI/DelphiASTTest.dpr @@ -2,8 +2,7 @@ program DelphiASTTest; uses Vcl.Forms, - uMainForm in 'uMainForm.pas' {Form2}, - forwardwithoutsemicolon in 'Snippets\forwardwithoutsemicolon.pas'; + uMainForm in 'uMainForm.pas' {Form2}; {$R *.res} diff --git a/Test/DelphiASTTest.dproj b/Test/GUI/DelphiASTTest.dproj similarity index 98% rename from Test/DelphiASTTest.dproj rename to Test/GUI/DelphiASTTest.dproj index 00a17af6..694ac923 100644 --- a/Test/DelphiASTTest.dproj +++ b/Test/GUI/DelphiASTTest.dproj @@ -38,7 +38,7 @@ DelphiASTTest System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - ..\Source;..\Source\SimpleParser;$(DCC_UnitSearchPath) + ..\..\Source;..\..\Source\SimpleParser;$(DCC_UnitSearchPath) $(BDS)\bin\default_app.manifest CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 1049 @@ -79,7 +79,7 @@
Form2
dfm - + Base diff --git a/Test/DelphiASTTest.lpr b/Test/GUI/DelphiASTTest.lpr similarity index 100% rename from Test/DelphiASTTest.lpr rename to Test/GUI/DelphiASTTest.lpr diff --git a/Test/uMainForm.dfm b/Test/GUI/uMainForm.dfm similarity index 100% rename from Test/uMainForm.dfm rename to Test/GUI/uMainForm.dfm diff --git a/Test/uMainForm.pas b/Test/GUI/uMainForm.pas similarity index 95% rename from Test/uMainForm.pas rename to Test/GUI/uMainForm.pas index 0c9b9277..974da607 100644 --- a/Test/uMainForm.pas +++ b/Test/GUI/uMainForm.pas @@ -50,7 +50,8 @@ procedure TForm2.btnRunClick(Sender: TObject); begin memLog.Clear; - Path := ExtractFilePath(Application.ExeName) + 'Snippets\'; + Path := ExpandFileName(ExtractFilePath(Application.ExeName) + '..' + + PathDelim + 'Snippets'); if not SelectDirectory('Select Folder', '', Path) then Exit; diff --git a/Test/UnitTests/DelphiAST.TestFramework.pas b/Test/UnitTests/DelphiAST.TestFramework.pas new file mode 100644 index 00000000..732b25ed --- /dev/null +++ b/Test/UnitTests/DelphiAST.TestFramework.pas @@ -0,0 +1,111 @@ +unit DelphiAST.TestFramework; + +{$IFDEF FPC}{$MODE DELPHI}{$ENDIF} + +interface + +uses + SysUtils; + +type + ETestFailure = class(Exception); + TTestProcedure = procedure; + +procedure AssertTrue(Condition: Boolean; const Message: string = ''); +procedure AssertFalse(Condition: Boolean; const Message: string = ''); +procedure AssertNotNil(Value: Pointer; const Message: string = ''); +procedure AssertEquals(Expected, Actual: Integer; const Message: string = ''); overload; +procedure AssertEquals(const Expected, Actual: string; const Message: string = ''); overload; +procedure AssertContains(const ExpectedPart, Actual: string; const Message: string = ''); +procedure RunTest(const Name: string; Test: TTestProcedure); +function FinishTests: Integer; + +implementation + +var + TestsRun: Integer; + TestsPassed: Integer; + TestsFailed: Integer; + +procedure Fail(const Message: string); +begin + raise ETestFailure.Create(Message); +end; + +procedure AssertTrue(Condition: Boolean; const Message: string); +begin + if not Condition then + if Message = '' then + Fail('Expected True') + else + Fail(Message); +end; + +procedure AssertFalse(Condition: Boolean; const Message: string); +begin + if Condition then + if Message = '' then + Fail('Expected False') + else + Fail(Message); +end; + +procedure AssertNotNil(Value: Pointer; const Message: string); +begin + if Value = nil then + if Message = '' then + Fail('Expected a non-nil value') + else + Fail(Message); +end; + +procedure AssertEquals(Expected, Actual: Integer; const Message: string); +begin + if Expected <> Actual then + Fail(Format('%s Expected %d but got %d', [Message, Expected, Actual])); +end; + +procedure AssertEquals(const Expected, Actual: string; const Message: string); +begin + if Expected <> Actual then + Fail(Format('%s Expected "%s" but got "%s"', [Message, Expected, Actual])); +end; + +procedure AssertContains(const ExpectedPart, Actual: string; const Message: string); +begin + if Pos(ExpectedPart, Actual) = 0 then + Fail(Format('%s Expected to find "%s"', [Message, ExpectedPart])); +end; + +procedure RunTest(const Name: string; Test: TTestProcedure); +begin + Inc(TestsRun); + WriteLn('[RUN ] ', Name); + Flush(Output); + try + Test; + Inc(TestsPassed); + WriteLn('[PASS] ', Name); + except + on E: Exception do + begin + Inc(TestsFailed); + WriteLn('[FAIL] ', Name); + WriteLn(' ', E.ClassName, ': ', E.Message); + {$IFDEF FPC}DumpExceptionBackTrace(Output);{$ENDIF} + end; + end; +end; + +function FinishTests: Integer; +begin + WriteLn; + WriteLn(Format('%d tests: %d passed, %d failed', + [TestsRun, TestsPassed, TestsFailed])); + if TestsFailed = 0 then + Result := 0 + else + Result := 1; +end; + +end. diff --git a/Test/UnitTests/DelphiAST.TestSupport.pas b/Test/UnitTests/DelphiAST.TestSupport.pas new file mode 100644 index 00000000..196792f1 --- /dev/null +++ b/Test/UnitTests/DelphiAST.TestSupport.pas @@ -0,0 +1,140 @@ +unit DelphiAST.TestSupport; + +{$IFDEF FPC}{$MODE DELPHI}{$ENDIF} + +interface + +uses + Classes, SysUtils, DelphiAST, DelphiAST.Classes, DelphiAST.Consts, + SimpleParser.Lexer.Types; + +type + TTestIncludeHandler = class(TInterfacedObject, IIncludeHandler) + private + FBasePath: string; + public + constructor Create(const BasePath: string); + function GetIncludeFileContent(const ParentFileName, IncludeName: string; + out Content: string; out FileName: string): Boolean; + end; + +function ParseSource(const Source: string): TSyntaxNode; +function ParseFile(const FileName, IncludePath: string): TSyntaxNode; +function FindDescendant(Node: TSyntaxNode; Typ: TSyntaxNodeType): TSyntaxNode; +function CountDescendants(Node: TSyntaxNode; Typ: TSyntaxNodeType): Integer; +function ResolveSnippetPath: string; + +implementation + +constructor TTestIncludeHandler.Create(const BasePath: string); +begin + inherited Create; + FBasePath := IncludeTrailingPathDelimiter(ExpandFileName(BasePath)); +end; + +function TTestIncludeHandler.GetIncludeFileContent(const ParentFileName, + IncludeName: string; out Content, FileName: string): Boolean; +var + Source: TStringList; +begin + FileName := ExpandFileName(FBasePath + IncludeName); + Result := FileExists(FileName); + if not Result then + Exit; + Source := TStringList.Create; + try + Source.LoadFromFile(FileName); + Content := Source.Text; + finally + Source.Free; + end; +end; + +function ParseSource(const Source: string): TSyntaxNode; +var + Builder: TPasSyntaxTreeBuilder; + Stream: TStringStream; +begin + Builder := TPasSyntaxTreeBuilder.Create; + Stream := TStringStream.Create(Source); + try + Stream.Position := 0; + Builder.InitDefinesDefinedByCompiler; + Result := Builder.Run(Stream); + finally + Stream.Free; + Builder.Free; + end; +end; + +function ParseFile(const FileName, IncludePath: string): TSyntaxNode; +var + Builder: TPasSyntaxTreeBuilder; + Stream: TFileStream; +begin + Builder := TPasSyntaxTreeBuilder.Create; + Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + Stream.Position := 0; + Builder.InitDefinesDefinedByCompiler; + Builder.IncludeHandler := TTestIncludeHandler.Create(IncludePath); + Result := Builder.Run(Stream); + finally + Stream.Free; + Builder.Free; + end; +end; + +function FindDescendant(Node: TSyntaxNode; Typ: TSyntaxNodeType): TSyntaxNode; +var + Child: TSyntaxNode; +begin + Result := nil; + if Node = nil then + Exit; + if Node.Typ = Typ then + Exit(Node); + for Child in Node.ChildNodes do + begin + Result := FindDescendant(Child, Typ); + if Result <> nil then + Exit; + end; +end; + +function CountDescendants(Node: TSyntaxNode; Typ: TSyntaxNodeType): Integer; +var + Child: TSyntaxNode; +begin + Result := 0; + if Node = nil then + Exit; + if Node.Typ = Typ then + Inc(Result); + for Child in Node.ChildNodes do + Inc(Result, CountDescendants(Child, Typ)); +end; + +function ResolveSnippetPath: string; +const + Candidates: array[0..3] of string = ( + 'Test/Snippets', '../Snippets', '../../Test/Snippets', '../../../Test/Snippets'); +var + I: Integer; + Candidate: string; +begin + if (ParamCount > 0) and DirectoryExists(ParamStr(1)) then + Exit(ExpandFileName(ParamStr(1))); + for I := Low(Candidates) to High(Candidates) do + begin + Candidate := ExpandFileName(Candidates[I]); + if DirectoryExists(Candidate) then + Exit(Candidate); + Candidate := ExpandFileName(ExtractFilePath(ParamStr(0)) + Candidates[I]); + if DirectoryExists(Candidate) then + Exit(Candidate); + end; + raise Exception.Create('Cannot locate Test/Snippets; pass its path as the first argument'); +end; + +end. diff --git a/Test/UnitTests/DelphiAST.Tests.pas b/Test/UnitTests/DelphiAST.Tests.pas new file mode 100644 index 00000000..6d15948c --- /dev/null +++ b/Test/UnitTests/DelphiAST.Tests.pas @@ -0,0 +1,239 @@ +unit DelphiAST.Tests; + +{$IFDEF FPC}{$MODE DELPHI}{$ENDIF} + +interface + +procedure RunAllTests; + +implementation + +uses + Classes, SysUtils, DelphiAST, DelphiAST.Classes, DelphiAST.Consts, + DelphiAST.Writer, DelphiAST.TestFramework, DelphiAST.TestSupport + {$IFNDEF FPC}, DelphiAST.Serialize.Binary{$ENDIF}; + +var + SnippetPath: string; + CurrentSnippet: string; + +procedure TestCurrentSnippet; +var + Root: TSyntaxNode; +begin + Root := ParseFile(CurrentSnippet, SnippetPath); + try + AssertNotNil(Root, 'Parser returned no syntax tree'); + AssertNotNil(FindDescendant(Root, ntUnit), 'Snippet has no unit node'); + finally + Root.Free; + end; +end; + +procedure RunSnippetTests; +var + Search: TSearchRec; + Code: Integer; +begin + SnippetPath := ResolveSnippetPath; + Code := FindFirst(IncludeTrailingPathDelimiter(SnippetPath) + '*.pas', faAnyFile, Search); + if Code <> 0 then + raise Exception.Create('No Pascal snippets found in ' + SnippetPath); + try + repeat + if (Search.Attr and faDirectory) = 0 then + begin + CurrentSnippet := IncludeTrailingPathDelimiter(SnippetPath) + Search.Name; + RunTest('Snippet.' + Search.Name, TestCurrentSnippet); + end; + Code := FindNext(Search); + until Code <> 0; + finally + FindClose(Search); + end; +end; + +procedure TestUnitStructure; +var + Root, UnitNode, IntfNode, ImplNode: TSyntaxNode; +begin + Root := ParseSource('unit Example;' + sLineBreak + + 'interface uses SysUtils; implementation end.'); + try + UnitNode := FindDescendant(Root, ntUnit); + AssertNotNil(UnitNode); + AssertEquals('Example', UnitNode.Attribute[anName], 'Unit name.'); + IntfNode := FindDescendant(UnitNode, ntInterface); + ImplNode := FindDescendant(UnitNode, ntImplementation); + AssertNotNil(IntfNode, 'Missing interface'); + AssertNotNil(ImplNode, 'Missing implementation'); + AssertNotNil(FindDescendant(IntfNode, ntUses), 'Missing uses clause'); + finally + Root.Free; + end; +end; + +procedure TestMethodAndParameters; +var + Root, MethodNode: TSyntaxNode; +begin + Root := ParseSource('unit Example; interface ' + + 'function Sum(A, B: Integer): Integer; implementation ' + + 'function Sum(A, B: Integer): Integer; begin Result := A + B; end; end.'); + try + MethodNode := FindDescendant(Root, ntMethod); + AssertNotNil(MethodNode); + AssertEquals('Sum', FindDescendant(MethodNode, ntName).Attribute[anName], + 'Method name.'); + AssertEquals(2, CountDescendants(MethodNode, ntParameter), 'Parameter count.'); + AssertNotNil(FindDescendant(MethodNode, ntReturnType), 'Missing return type'); + AssertNotNil(FindDescendant(Root, ntAssign), 'Missing assignment'); + AssertNotNil(FindDescendant(Root, ntAdd), 'Missing addition expression'); + finally + Root.Free; + end; +end; + +procedure TestControlFlow; +var + Root: TSyntaxNode; +begin + Root := ParseSource('unit Example; interface implementation procedure Run; ' + + 'var I: Integer; begin for I := 1 to 3 do if I > 1 then while I > 0 do ' + + 'I := I - 1; end; end.'); + try + AssertNotNil(FindDescendant(Root, ntFor), 'Missing for statement'); + AssertNotNil(FindDescendant(Root, ntIf), 'Missing if statement'); + AssertNotNil(FindDescendant(Root, ntWhile), 'Missing while statement'); + finally + Root.Free; + end; +end; + +procedure TestExceptionHandling; +var + Root: TSyntaxNode; +begin + Root := ParseSource('unit Example; interface implementation procedure Run; ' + + 'begin try DoWork; except on E: Exception do Handle(E); end; end; end.'); + try + AssertNotNil(FindDescendant(Root, ntTry), 'Missing try statement'); + AssertNotNil(FindDescendant(Root, ntExcept), 'Missing except block'); + AssertNotNil(FindDescendant(Root, ntExceptionHandler), 'Missing exception handler'); + finally + Root.Free; + end; +end; + +procedure TestGenericRecordAndProperty; +var + Root: TSyntaxNode; +begin + Root := ParseSource('unit Example; interface type ' + + 'TBox = class private FValue: T; public property Value: T read FValue; end; ' + + 'TPair = record Left, Right: Integer; end; implementation end.'); + try + AssertNotNil(FindDescendant(Root, ntTypeParams), 'Missing generic parameters'); + AssertNotNil(FindDescendant(Root, ntClassConstraint), 'Missing class constraint'); + AssertNotNil(FindDescendant(Root, ntProperty), 'Missing property'); + AssertTrue(CountDescendants(Root, ntTypeDecl) >= 2, 'Missing type declarations'); + finally + Root.Free; + end; +end; + +procedure TestLiteralsAndUnicode; +var + Root: TSyntaxNode; + Xml: string; +begin + Root := ParseSource('unit Umlaut; interface const Greeting = ''Grüße & ''; ' + + 'implementation end.'); + try + AssertTrue(CountDescendants(Root, ntLiteral) > 0, 'Missing literal'); + Xml := TSyntaxTreeWriter.ToXML(Root, False, True); + AssertContains('', Xml, 'Missing XML header.'); + AssertContains('&', Xml, 'Ampersand was not encoded.'); + AssertContains('<', Xml, 'Less-than sign was not encoded.'); + finally + Root.Free; + end; +end; + +procedure TestSourcePositions; +var + Root, UnitNode: TSyntaxNode; +begin + Root := ParseSource('unit Positioned;' + sLineBreak + 'interface' + sLineBreak + + 'implementation' + sLineBreak + 'end.'); + try + UnitNode := FindDescendant(Root, ntUnit); + AssertTrue(UnitNode.Line > 0, 'Unit line must be positive'); + AssertTrue(UnitNode.Col > 0, 'Unit column must be positive'); + AssertTrue(TCompoundSyntaxNode(FindDescendant(Root, ntInterface)).EndLine >= 2, + 'Interface end position was not recorded'); + finally + Root.Free; + end; +end; + +procedure TestInvalidSyntax; +var + Root: TSyntaxNode; + Raised: Boolean; +begin + Root := nil; + Raised := False; + try + Root := ParseSource('unit Broken; interface implementation begin'); + except + on ESyntaxTreeException do + Raised := True; + end; + Root.Free; + AssertTrue(Raised, 'Invalid syntax did not raise ESyntaxTreeException'); +end; + +{$IFNDEF FPC} +procedure TestBinarySerializationRoundTrip; +var + OriginalRoot, RestoredRoot: TSyntaxNode; + Serializer: TBinarySerializer; + Stream: TMemoryStream; +begin + OriginalRoot := ParseSource('unit BinaryRoundTrip; interface implementation end.'); + RestoredRoot := nil; + Serializer := TBinarySerializer.Create; + Stream := TMemoryStream.Create; + try + AssertTrue(Serializer.Write(Stream, OriginalRoot), 'Binary write failed'); + Stream.Position := 0; + AssertTrue(Serializer.Read(Stream, RestoredRoot), 'Binary read failed'); + AssertEquals(TSyntaxTreeWriter.ToXML(OriginalRoot, False, False), + TSyntaxTreeWriter.ToXML(RestoredRoot, False, False), 'Round-trip tree.'); + finally + Stream.Free; + Serializer.Free; + RestoredRoot.Free; + OriginalRoot.Free; + end; +end; +{$ENDIF} + +procedure RunAllTests; +begin + RunTest('AST.UnitStructure', TestUnitStructure); + RunTest('AST.MethodAndParameters', TestMethodAndParameters); + RunTest('AST.ControlFlow', TestControlFlow); + RunTest('AST.ExceptionHandling', TestExceptionHandling); + RunTest('AST.GenericRecordAndProperty', TestGenericRecordAndProperty); + RunTest('Writer.LiteralsUnicodeAndXmlEscaping', TestLiteralsAndUnicode); + RunTest('AST.SourcePositions', TestSourcePositions); + RunTest('Parser.InvalidSyntax', TestInvalidSyntax); + {$IFNDEF FPC} + RunTest('Serialization.BinaryRoundTrip', TestBinarySerializationRoundTrip); + {$ENDIF} + RunSnippetTests; +end; + +end. diff --git a/Test/UnitTests/DelphiASTTests.dpr b/Test/UnitTests/DelphiASTTests.dpr new file mode 100644 index 00000000..ab38b7d1 --- /dev/null +++ b/Test/UnitTests/DelphiASTTests.dpr @@ -0,0 +1,14 @@ +program DelphiASTTests; + +{$APPTYPE CONSOLE} + +uses + System.SysUtils, + DelphiAST.Tests in 'DelphiAST.Tests.pas', + DelphiAST.TestFramework in 'DelphiAST.TestFramework.pas', + DelphiAST.TestSupport in 'DelphiAST.TestSupport.pas'; + +begin + RunAllTests; + ExitCode := FinishTests; +end. diff --git a/Test/UnitTests/DelphiASTTests.dproj b/Test/UnitTests/DelphiASTTests.dproj new file mode 100644 index 00000000..88d5cf57 --- /dev/null +++ b/Test/UnitTests/DelphiASTTests.dproj @@ -0,0 +1,24 @@ + + + {BE6F065D-472C-4D09-9799-14BA15600EBB} + 20.3 + None + True + Debug + Win32 + 1 + Console + DelphiASTTests.dpr + + + ..\..\Source;..\..\Source\SimpleParser;..\..\Source\FreePascalSupport;$(DCC_UnitSearchPath) + System;Xml;Data;$(DCC_Namespace) + + + MainSource + + + + + + diff --git a/Test/UnitTests/DelphiASTTests.lpr b/Test/UnitTests/DelphiASTTests.lpr new file mode 100644 index 00000000..139e40c2 --- /dev/null +++ b/Test/UnitTests/DelphiASTTests.lpr @@ -0,0 +1,13 @@ +program DelphiASTTests; + +{$MODE DELPHI} + +uses + SysUtils, + DelphiAST.Tests, + DelphiAST.TestFramework; + +begin + RunAllTests; + ExitCode := FinishTests; +end. diff --git a/docs/superpowers/specs/2026-07-13-cross-compiler-tests-design.md b/docs/superpowers/specs/2026-07-13-cross-compiler-tests-design.md new file mode 100644 index 00000000..68671a79 --- /dev/null +++ b/docs/superpowers/specs/2026-07-13-cross-compiler-tests-design.md @@ -0,0 +1,122 @@ +# Cross-Compiler Headless Tests and CI Design + +## Objective + +Replace the interactive-only test path with an exhaustive headless test suite that +runs the same test logic under Delphi and Free Pascal Compiler (FPC), while +preserving the existing GUI test application. Add GitHub Actions coverage for the +FPC suite and repair the non-rendering code-statistics badges in the README. + +## Directory Layout + +The current GUI application will move from `Test` to `Test/GUI`. Its project and +form files will be adjusted for their new relative paths but its behavior will +remain unchanged. + +The headless suite will live in `Test/UnitTests`. It will contain two thin project +entry points: + +- A Delphi project (`DelphiASTTests.dpr` and `DelphiASTTests.dproj`). +- An FPC project (`DelphiASTTests.lpr`). + +The project entry points will contain only compiler-specific startup declarations +and calls into the shared runner. All test registration, runner behavior, +assertions, fixtures, include handling, and test cases will be implemented in +common Pascal units compiled unchanged by both projects. + +## Test Framework + +The suite will use a small dependency-free framework because no established test +framework supplies one identical dependency and console runner for both Delphi +and FPC. FPCUnit and DUnit are only roughly source-compatible and require distinct +runners; DUnitX does not support FPC. Pulling in a much larger cross-compiler +framework solely for its test facilities would add unnecessary project weight. + +The shared framework will provide: + +- Named test registration and deterministic execution order. +- Per-test isolation and cleanup. +- Equality, truth, nil/non-nil, and expected-exception assertions needed by this + suite. +- Clear console reporting with passed, failed, and total counts. +- Failure details that identify the test and assertion or unexpected exception. +- Process exit code zero on success and nonzero on any failure. + +Compiler conditionals may adapt small RTL differences, but test meaning and +results must remain the same under Delphi and FPC. + +## Test Coverage + +Every Pascal snippet currently under `Test/Snippets` will remain test data and +will become an automatically enumerated parse-success test. The suite will accept +an optional test-data path and otherwise locate the snippets relative to the +repository or executable, so IDE, command-line, and CI runs behave consistently. +Include-file lookup will be headless and deterministic. + +Focused shared tests will expand coverage beyond "parsing did not raise". They +will verify representative AST structure and values for: + +- Units, interfaces, implementations, uses clauses, and declarations. +- Procedures, functions, parameters, return types, calling conventions, and + anonymous methods. +- Classes, interfaces, records, helpers, visibility, properties, generics, + constraints, attributes, and directives. +- Statements, assignments, calls, control flow, exception handling, and common + expression/operator forms. +- Numeric and string literals, Unicode input, comments, conditional directives, + include files, and source positions. +- Recently repaired parser cases represented by the existing regression snippets. +- Invalid or incomplete syntax where a specific parser failure is expected. +- Writer output and serialization round trips where the public APIs support stable + assertions. + +Tests will assert semantic AST facts rather than entire unstable object dumps +unless an output format is explicitly intended to be stable. Temporary objects +and files will be cleaned up even after failures. Optional compiler-specific leak +diagnostics may supplement the run but must not alter shared test semantics. + +## GitHub Actions + +A workflow under `.github/workflows` will run on pushes and pull requests. On an +Ubuntu runner it will: + +1. Check out the repository. +2. Install a supported stable FPC toolchain. +3. Compile the FPC headless project with warnings visible and explicit source-unit + paths. +4. Execute the compiled suite against the repository's test data. + +Compilation errors, missing test data, failed assertions, and unexpected +exceptions will fail the job. Generated compiler artifacts will be directed to a +build directory or otherwise kept out of source directories. + +## README and Tokei Badges + +The README will document how to build and run each headless project with FPC and +Delphi. It will describe the GUI application as an optional interactive parser +exercise rather than the automated suite. + +The three broken `tokei.rs` badges were intended to report: + +- `lines`: total physical lines in counted source files. +- `code`: code lines after excluding comments and blank lines. +- `files`: the number of counted source files. + +They will be changed to the corresponding endpoints of an operating Tokei badge +service while retaining those meanings and links back to repository statistics. + +## Verification and Acceptance + +The implementation is accepted when: + +- The GUI project builds from `Test/GUI` with its paths corrected. +- The Delphi and FPC console projects contain distinct entry points but compile + the same shared framework and tests. +- The FPC executable runs every existing snippet plus the focused tests and exits + successfully locally. +- A deliberately failing test is confirmed to produce useful output and a nonzero + exit code, then removed. +- The workflow syntax is valid and mirrors the successful local FPC commands. +- README badge image endpoints return SVG images representing lines, code, and + files. +- No unrelated user files or working-tree changes are modified.