binaryheap.tests.inc

// THIS FILE WAS GENERATED BY CLAUDE with a variety of modifications to make it work

type
  { Utils for integer min-heap: root = smallest }
  TIntMinUtils = record
    class function IsOrdered(const A, B: Integer): Boolean; static; inline;
  end;

  { Utils for integer max-heap: root = largest }
  TIntMaxUtils = record
    class function IsOrdered(const A, B: Integer): Boolean; static; inline;
  end;

  TIntArray = array of Integer;

  TIntMinHeap        = specialize THeap<Integer, TIntMinUtils>;
  TIntMaxHeap        = specialize THeap<Integer, TIntMaxUtils>;

class function TIntMinUtils.IsOrdered(const A, B: Integer): Boolean;
begin
  Result := A <= B;
end;

class function TIntMaxUtils.IsOrdered(const A, B: Integer): Boolean;
begin
  Result := A >= B;
end;

{ ──────────────────────────────────────────────────────────── }
{ Helpers                                                       }
{ ──────────────────────────────────────────────────────────── }

var
  PassCount, FailCount: Integer;

procedure Check(const Condition: Boolean; const TestName: string);
begin
  if Condition then
  begin
    Inc(PassCount);
  end
  else
  begin
    Inc(FailCount);
    WriteLn('  FAIL  ', TestName);
  end;
end;

{ Drain the heap and return extracted values in extraction order. }
function DrainMin(var H: TIntMinHeap): TIntArray;
var
  I: Integer;
begin
  SetLength(Result, H.Count); // {BOGUS Warning: Function result variable of a managed type does not seem to be initialized}
  for I := 0 to High(Result) do // $R-
    Result[I] := H.Extract();
end;

function DrainMax(var H: TIntMaxHeap): TIntArray;
var
  I: Integer;
begin
  SetLength(Result, H.Count); // {BOGUS Warning: Function result variable of a managed type does not seem to be initialized}
  for I := 0 to High(Result) do // $R-
    Result[I] := H.Extract();
end;

{ Returns True when Arr is non-decreasing. }
function IsSorted(const Arr: TIntArray): Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 1 to High(Arr) do // $R-
    if Arr[I] < Arr[I - 1] then
    begin
      Result := False;
      Exit;
    end;
end;

{ Returns True when Arr is non-increasing. }
function IsReverseSorted(const Arr: TIntArray): Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 1 to High(Arr) do // $R-
    if Arr[I] > Arr[I - 1] then
    begin
      Result := False;
      Exit;
    end;
end;

function ArrEqual(const A, B: TIntArray): Boolean;
var
  I: Integer;
begin
  if Length(A) <> Length(B) then Exit(False);
  for I := 0 to High(A) do // $R-
    if A[I] <> B[I] then Exit(False);
  Result := True;
end;

{ ──────────────────────────────────────────────────────────── }
{ Test groups                                                   }
{ ──────────────────────────────────────────────────────────── }

{ 1. Basic min-heap property after sequential inserts }
procedure TestMinHeapOrdering;
var
  H: TIntMinHeap;
  Got: TIntArray;
begin
  { Insert in ascending order }
  H.Insert(1); H.Insert(2); H.Insert(3); H.Insert(4); H.Insert(5);
  Got := DrainMin(H);
  Check(IsSorted(Got), 'ascending insert → extracts ascending');

  { Insert in descending order }
  H.Insert(5); H.Insert(4); H.Insert(3); H.Insert(2); H.Insert(1);
  Got := DrainMin(H);
  Check(IsSorted(Got), 'descending insert → extracts ascending');

  Check(H.Count = 0, 'extracts did not empty heap');
  { Insert in random order }
  H.Insert(3); H.Insert(1); H.Insert(4); H.Insert(1); H.Insert(5);
  H.Insert(9); H.Insert(2); H.Insert(6);
  Got := DrainMin(H);
  Check(IsSorted(Got), 'random insert → extracts ascending');

  { Minimum is always at the root before extraction }
  H.Insert(7); H.Insert(2); H.Insert(9); H.Insert(1); H.Insert(5);
  Check(H.Extract() = 1, 'first Extract returns global minimum');
  Check(H.Extract() = 2, 'second Extract returns next minimum');
end;

{ 2. Basic max-heap property }
procedure TestMaxHeapOrdering;
var
  H: TIntMaxHeap;
  Got: TIntArray;
begin
  H.Insert(3); H.Insert(1); H.Insert(4); H.Insert(1); H.Insert(5);
  H.Insert(9); H.Insert(2); H.Insert(6);
  Got := DrainMax(H);
  Check(IsReverseSorted(Got), 'random insert → extracts descending');

  H.Insert(10); H.Insert(20); H.Insert(5);
  Check(H.Extract() = 20, 'max-heap Extract returns maximum');
end;

{ 3. AdoptInit (heapify) — drawn from CPython heapq._heapify_max tests }
procedure TestAdoptInit;
var
  H: TIntMinHeap;
  Src: TIntArray;
  Got: TIntArray;
  Expected: TIntArray;
begin
  { Sorted input }
  Src := TIntArray.Create(1, 2, 3, 4, 5, 6, 7);
  H.AdoptInit(Src);
  Got := DrainMin(H);
  Expected := TIntArray.Create(1, 2, 3, 4, 5, 6, 7);
  Check(ArrEqual(Got, Expected), 'heapify sorted array → correct order');

  { Reverse-sorted input }
  Src := TIntArray.Create(7, 6, 5, 4, 3, 2, 1);
  H.AdoptInit(Src);
  Got := DrainMin(H);
  Check(ArrEqual(Got, Expected), 'heapify reverse-sorted array → correct order');

  { Single element }
  Src := TIntArray.Create(42);
  H.AdoptInit(Src);
  Check(H.Count = 1,       'heapify single element → Count = 1');
  Check(H.Extract() = 42,  'heapify single element → Extract returns it');

  { Empty array }
  Src := nil;
  H.AdoptInit(Src);
  Check(H.Count = 0, 'heapify empty array → Count = 0');

  { Power-of-two minus 1 (complete tree boundary) }
  Src := TIntArray.Create(15,14,13,12,11,10,9,8,7,6,5,4,3,2,1);
  H.AdoptInit(Src);
  Got := DrainMin(H);
  Check(IsSorted(Got), 'heapify 15-element reverse array → sorted extraction');
end;

{ 4. Count property }
procedure TestCount;
var
  H: TIntMinHeap;
begin
  Check(H.Count = 0, 'empty heap Count = 0'); // {BOGUS Warning: Local variable "H" of a managed type does not seem to be initialized}

  H.Insert(1);
  Check(H.Count = 1, 'Count = 1 after one Insert');

  H.Insert(2); H.Insert(3);
  Check(H.Count = 3, 'Count = 3 after three inserts');

  H.Extract();
  Check(H.Count = 2, 'Count decrements after Extract');

  H.Extract(); H.Extract();
  Check(H.Count = 0, 'Count = 0 after all extracted');
end;

{ 5. Duplicate values — from Python heapq test suite }
procedure TestDuplicates;
var
  H: TIntMinHeap;
  Got: TIntArray;
var
  I: Integer;
begin
  H.Insert(3); H.Insert(3); H.Insert(3);
  Got := DrainMin(H);
  Check((Got[0] = 3) and (Got[1] = 3) and (Got[2] = 3),
        'all-duplicate heap extracts all copies');

  H.Insert(1); H.Insert(1); H.Insert(2); H.Insert(1);
  Check(H.Count = 4, 'duplicates all counted');
  Got := DrainMin(H);
  Check(IsSorted(Got), 'duplicates sorted correctly on extraction');

  { Large number of duplicates }
  for I := 1 to 100 do
    H.Insert(7);
  Check(H.Count = 100, '100 duplicate inserts → Count = 100');
  for I := 1 to 100 do
    Check(H.Extract() = 7, 'every extracted duplicate = 7');
end;

{ 6. InsertThenExtract and ExtractThenInsert }
{ Semantics verified against Python heapq.heappushpop / heapreplace }
procedure TestMergeOps;
var
  H: TIntMinHeap;
  R: Integer;
begin
  { InsertThenExtract: equivalent to Insert followed by Extract,
    but must never return a value larger than NewValue
    when NewValue is already ≤ all heap elements. }
  H.Insert(3); H.Insert(5); H.Insert(7);

  { Push 1 (new min), pop should return 1 }
  R := H.InsertThenExtract(1);
  Check(R = 1, 'InsertThenExtract(1) on [3,5,7] = 1 (new value is smallest)');
  Check(H.Count = 3, 'InsertThenExtract does not change Count');

  { Push 4, pop should return 3 (existing min) }
  H.Clear();
  H.Insert(3); H.Insert(5); H.Insert(7);
  R := H.InsertThenExtract(4);
  Check(R = 3, 'InsertThenExtract(4) on [3,5,7] = 3');

  { Push 10 (new max), pop should return 3 }
  H.Clear();
  H.Insert(3); H.Insert(5); H.Insert(7);
  R := H.InsertThenExtract(10);
  Check(R = 3, 'InsertThenExtract(10) on [3,5,7] = 3');

  { ExtractThenInsert: equivalent to Extract followed by Insert;
    the previous minimum is returned and NewValue takes its place. }
  H.Clear();
  H.Insert(3); H.Insert(5); H.Insert(7);
  Check(H.Count = 3, 'Count is correct after Insert');

  R := H.ExtractThenInsert(2);
  Check(R = 3, 'ExtractThenInsert(2) returns old min = 3');
  Check(H.Count = 3, 'ExtractThenInsert does not change Count');
  { Heap should now contain [2, 5, 7] }
  R := H.Extract();
  Check(R = 2, 'after ExtractThenInsert(2), new min = 2');

  H.Clear();
  H.Insert(3); H.Insert(5); H.Insert(7);
  R := H.ExtractThenInsert(9);
  Check(R = 3, 'ExtractThenInsert(9) returns old min = 3');
  { Heap should now contain [5, 7, 9] }
  Check(H.Extract() = 5, 'after ExtractThenInsert(9), next min = 5');

  { InsertThenExtract on single-element heap }
  H.Clear();
  H.Insert(10);
  R := H.InsertThenExtract(5);
  Check(R = 5, 'InsertThenExtract(5) on [10] = 5');

  H.Clear();
  H.Insert(10);
  R := H.InsertThenExtract(20);
  Check(R = 10, 'InsertThenExtract(20) on [10] = 10');
end;

{ 7. Heap sort equivalence — from Go container/heap tests }
{ Repeated Extract from a min-heap must produce a fully sorted sequence. }
procedure TestHeapSort;
var
  H: TIntMinHeap;
  Src: TIntArray;
  Got: TIntArray;
  I, N: Integer;
begin
  { Small fixed input }
  Src := TIntArray.Create(5, 1, 3, 2, 4);
  for I := 0 to High(Src) do H.Insert(Src[I]); // $R-
  Got := DrainMin(H);
  Check(IsSorted(Got), 'heap-sort: small array');

  { Already sorted }
  N := 20;
  SetLength(Src, N);
  for I := 0 to N - 1 do Src[I] := I + 1; // $R-
  for I := 0 to High(Src) do H.Insert(Src[I]); // $R-
  Got := DrainMin(H);
  Check(IsSorted(Got), 'heap-sort: already sorted input');

  { Reverse sorted }
  for I := 0 to N - 1 do Src[I] := N - I; // $R-
  for I := 0 to High(Src) do H.Insert(Src[I]); // $R-
  Got := DrainMin(H);
  Check(IsSorted(Got), 'heap-sort: reverse sorted input');

  { Interleaved inserts and extracts still maintain sort order }
  H.Insert(5); H.Insert(2); H.Insert(8);
  Check(H.Extract() = 2, 'interleaved: Extract after 3 inserts = min');
  H.Insert(1); H.Insert(6);
  Check(H.Extract() = 1, 'interleaved: Extract after more inserts = new min');
  H.Insert(3);
  Got := DrainMin(H);
  Check(IsSorted(Got), 'interleaved: remaining elements extracted in order');
end;

{ 8. Large / stress test — from Java PriorityQueue tests }
procedure TestStress;
const
  N = 10000;
var
  H: TIntMinHeap;
  Prev, Curr: Integer;
  I: Integer;
var
  LCG: Int64 = 12345;
begin
  { Insert 0..N-1 in sequential order }
  for I := 0 to N - 1 do
    H.Insert(I);
  Check(H.Count = N, 'stress sequential: Count = N');
  Prev := H.Extract();
  for I := 1 to N - 1 do
  begin
    Curr := H.Extract();
    if Curr < Prev then
    begin
      Check(False, 'stress sequential: order violation at index ' + IntToStr(I));
      Exit;
    end;
    Prev := Curr;
  end;
  Check(True, 'stress sequential: all ' + IntToStr(N) + ' elements in order');

  { Insert N-1..0 in reverse order }
  for I := N - 1 downto 0 do
    H.Insert(I);
  Check(H.Count = N, 'stress reverse: Count = N');
  Prev := H.Extract();
  for I := 1 to N - 1 do
  begin
    Curr := H.Extract();
    if Curr < Prev then
    begin
      Check(False, 'stress reverse: order violation at index ' + IntToStr(I));
      Exit;
    end;
    Prev := Curr;
  end;
  Check(True, 'stress reverse: all ' + IntToStr(N) + ' elements in order');

  { Pseudo-random via LCG (reproducible, no RTL dependency) }
  for I := 0 to N - 1 do
  begin
    LCG := (LCG * 6364136223846793005 + 1442695040888963407) and $7FFFFFFF;
    H.Insert(Integer(LCG mod 100000));
  end;
  Check(H.Count = N, 'stress random: Count = N');
  Prev := H.Extract();
  for I := 1 to N - 1 do
  begin
    Curr := H.Extract();
    if Curr < Prev then
    begin
      Check(False, 'stress random: order violation at index ' + IntToStr(I));
      Exit;
    end;
    Prev := Curr;
  end;
  Check(True, 'stress random: ' + IntToStr(N) + ' random elements in order');
end;

{ 9. AdoptInit with ExpectedInsertionCount hint }
{ The hint must not affect correctness, only (optionally) performance. }
procedure TestAdoptInitHint;
var
  H: TIntMinHeap;
  Src: TIntArray;
  Got: TIntArray;
  I: Integer;
begin
  Src := TIntArray.Create(5, 3, 8, 1, 9, 2);
  H.AdoptInit(Src, 100);   { hint: expect 100 more inserts }
  for I := 10 to 15 do
    H.Insert(I);
  Got := DrainMin(H);
  Check(IsSorted(Got), 'hint does not affect ordering correctness');
  Check(Length(Got) = 12, 'hint does not affect final element count');

  { Zero hint }
  Src := TIntArray.Create(4, 2, 6);
  H.AdoptInit(Src, 0);
  Got := DrainMin(H);
  Check(IsSorted(Got), 'zero hint: correct ordering');
end;

{ 10. Single-element edge cases }
procedure TestSingleElement;
var
  H: TIntMinHeap;
begin
  H.Insert(42);
  Check(H.Count = 1,      'single element: Count = 1');
  Check(H.Extract() = 42, 'single element: Extract returns it');
  Check(H.Count = 0,      'single element: Count = 0 after Extract');

  { Negative values }
  H.Insert(-1); H.Insert(-5); H.Insert(-3);
  Check(H.Extract() = -5, 'negatives: min-heap returns most negative first');

  { Low(Integer) / High(Integer) }
  H.Clear();
  H.Insert(High(Integer));
  H.Insert(Low(Integer));
  H.Insert(0);
  Check(H.Extract() = Low(Integer), 'boundary: Low(Integer) extracted first');
  Check(H.Extract() = 0,      'boundary: 0 extracted second');
  Check(H.Extract() = High(Integer), 'boundary: High(Integer) extracted last');
end;

{ ──────────────────────────────────────────────────────────── }
{ Entry point                                                   }
{ ──────────────────────────────────────────────────────────── }

procedure RunTests;
begin
  PassCount := 0;
  FailCount := 0;

  TestMinHeapOrdering;
  TestMaxHeapOrdering;
  TestAdoptInit;
  TestCount;
  TestDuplicates;
  TestMergeOps;
  TestHeapSort;
  TestStress;
  TestAdoptInitHint;
  TestSingleElement;

  if (FailCount > 0) then
    WriteLn('THeap test results: ', PassCount, ' passed, ', FailCount, ' failed');
end;