Feature/fpc headless tests

.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

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;

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('</' + UpperCase(SyntaxNodeNames[Node.Typ]) + '>');
+      Builder.Append('</' + UpperCase(SyntaxNodeNames.Items[Node.Typ]) + '>');
       if Formatted then
         Builder.AppendLine;
     end;

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;
 

Test/DelphiASTTest.dpr → 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}
 

Test/DelphiASTTest.dproj → Test/GUI/DelphiASTTest.dproj

@@ -38,7 +38,7 @@
     <PropertyGroup Condition="'$(Base)'!=''">
         <SanitizedProjectName>DelphiASTTest</SanitizedProjectName>
         <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
-        <DCC_UnitSearchPath>..\Source;..\Source\SimpleParser;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
+        <DCC_UnitSearchPath>..\..\Source;..\..\Source\SimpleParser;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
         <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
         <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
         <VerInfo_Locale>1049</VerInfo_Locale>
@@ -79,7 +79,7 @@
             <Form>Form2</Form>
             <FormType>dfm</FormType>
         </DCCReference>
-        <DCCReference Include="Snippets\forwardwithoutsemicolon.pas"/>
+        <DCCReference Include="..\Snippets\forwardwithoutsemicolon.pas"/>
         <BuildConfiguration Include="Base">
             <Key>Base</Key>
         </BuildConfiguration>

Test/uMainForm.pas → 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;
 

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.