// THIS FILE WAS GENERATED BY CLAUDE with minor hand-written modifications // ========================================================================= // Utils implementations used for testing // ========================================================================= type TIntUtils = record class function Equals(const A, B: Integer): Boolean; static; inline; class function LessThan(const A, B: Integer): Boolean; static; inline; class function GreaterThan(const A, B: Integer): Boolean; static; inline; class function Compare(const A, B: Integer): Int64; static; inline; end; TStrUtils = record class function Equals(const A, B: AnsiString): Boolean; static; inline; class function LessThan(const A, B: AnsiString): Boolean; static; inline; class function GreaterThan(const A, B: AnsiString): Boolean; static; inline; class function Compare(const A, B: AnsiString): Int64; static; inline; end; TIntArray = specialize PlasticArray; TStrArray = specialize PlasticArray; class function TIntUtils.Equals(const A, B: Integer): Boolean; begin Result := A = B; end; class function TIntUtils.LessThan(const A, B: Integer): Boolean; begin Result := A < B; end; class function TIntUtils.GreaterThan(const A, B: Integer): Boolean; begin Result := A > B; end; class function TIntUtils.Compare(const A, B: Integer): Int64; begin if A < B then Result := -1 else if A > B then Result := 1 else Result := 0; end; class function TStrUtils.Equals(const A, B: AnsiString): Boolean; begin Result := A = B; end; class function TStrUtils.LessThan(const A, B: AnsiString): Boolean; begin Result := A < B; end; class function TStrUtils.GreaterThan(const A, B: AnsiString): Boolean; begin Result := A > B; end; class function TStrUtils.Compare(const A, B: AnsiString): Int64; begin if A < B then Result := -1 else if A > B then Result := 1 else Result := 0; end; // ========================================================================= // Lifecycle tracking type for managed-operator tests // ========================================================================= type TLifecycleEvent = (leInitialize, leFinalize, leCopy, leAddRef); TLifecycleLog = array of TLifecycleEvent; var GLifecycleLog: TLifecycleLog; GLifecycleLogCount: Integer; procedure LogEvent(Event: TLifecycleEvent); begin if GLifecycleLogCount >= System.Length(GLifecycleLog) then SetLength(GLifecycleLog, GLifecycleLogCount * 2 + 8); GLifecycleLog[GLifecycleLogCount] := Event; Inc(GLifecycleLogCount); end; procedure ResetLog(); begin GLifecycleLogCount := 0; end; type TTracked = record Value: Integer; class operator Initialize(var T: TTracked); class operator Finalize(var T: TTracked); class operator Copy(constref Src: TTracked; var Dst: TTracked); class operator AddRef(var T: TTracked); end; TTrackedUtils = record class function Equals(const A, B: TTracked): Boolean; static; inline; class function LessThan(const A, B: TTracked): Boolean; static; inline; class function GreaterThan(const A, B: TTracked): Boolean; static; inline; class function Compare(const A, B: TTracked): Int64; static; inline; end; TTrackedArray = specialize PlasticArray; class operator TTracked.Initialize(var T: TTracked); begin T.Value := 0; LogEvent(leInitialize); end; class operator TTracked.Finalize(var T: TTracked); begin LogEvent(leFinalize); end; class operator TTracked.Copy(constref Src: TTracked; var Dst: TTracked); begin Dst.Value := Src.Value; LogEvent(leCopy); end; class operator TTracked.AddRef(var T: TTracked); begin LogEvent(leAddRef); end; class function TTrackedUtils.Equals(const A, B: TTracked): Boolean; begin Result := A.Value = B.Value; end; class function TTrackedUtils.LessThan(const A, B: TTracked): Boolean; begin Result := A.Value < B.Value; end; class function TTrackedUtils.GreaterThan(const A, B: TTracked): Boolean; begin Result := A.Value > B.Value; end; class function TTrackedUtils.Compare(const A, B: TTracked): Int64; begin if A.Value < B.Value then Result := -1 else if A.Value > B.Value then Result := 1 else Result := 0; end; // ========================================================================= // Comparison helpers for Sort calls // ========================================================================= function IntAscending(const A, B: Integer): Integer; begin if A < B then Result := -1 else if A > B then Result := 1 else Result := 0; end; function IntDescending(const A, B: Integer): Integer; begin if A > B then Result := -1 else if A < B then Result := 1 else Result := 0; end; // ========================================================================= // RunTests // ========================================================================= procedure RunTests(); procedure Fail(const Msg: AnsiString); begin WriteLn('FAILURE: ', Msg); Halt(1); end; procedure AssertTrue(const Condition: Boolean; const Msg: AnsiString); begin if not Condition then Fail(Msg); end; procedure AssertFalse(const Condition: Boolean; const Msg: AnsiString); begin if Condition then Fail(Msg); end; procedure AssertEquals(const Got, Expected: Integer; const Msg: AnsiString); overload; begin if Got <> Expected then Fail(Msg + ' (got ' + IntToStr(Got) + ', expected ' + IntToStr(Expected) + ')'); end; procedure AssertEquals(const Got, Expected: AnsiString; const Msg: AnsiString); overload; begin if Got <> Expected then Fail(Msg + ' (got "' + Got + '", expected "' + Expected + '")'); end; function EventName(E: TLifecycleEvent): AnsiString; begin case E of leInitialize: Result := 'Initialize'; leFinalize: Result := 'Finalize'; leCopy: Result := 'Copy'; leAddRef: Result := 'AddRef'; end; end; procedure AssertNextEvent(var Cursor: Integer; Expected: TLifecycleEvent; const Msg: AnsiString); begin if Cursor >= GLifecycleLogCount then Fail(Msg + ': expected ' + EventName(Expected) + ' but log ended at position ' + IntToStr(Cursor)); if GLifecycleLog[Cursor] <> Expected then Fail(Msg + ': at position ' + IntToStr(Cursor) + ' expected ' + EventName(Expected) + ' but got ' + EventName(GLifecycleLog[Cursor])); Inc(Cursor); end; procedure AssertNoMoreEvents(const Cursor: Integer; const Msg: AnsiString); var I: Integer; Remaining: AnsiString; begin if Cursor <> GLifecycleLogCount then begin Remaining := ''; for I := Cursor to GLifecycleLogCount - 1 do // $R- begin if Remaining <> '' then Remaining := Remaining + ', '; Remaining := Remaining + IntToStr(I) + ':' + EventName(GLifecycleLog[I]); end; Fail(Msg + ': expected no more events at position ' + IntToStr(Cursor) + ' but ' + IntToStr(GLifecycleLogCount - Cursor) + ' remain: [' + Remaining + ']'); end; end; function CountEvents(const Event: TLifecycleEvent): Integer; var I: Integer; begin Result := 0; for I := 0 to GLifecycleLogCount - 1 do // $R- if GLifecycleLog[I] = Event then Inc(Result); end; function MakeIntArray(const Values: array of Integer): TIntArray; var I: Integer; begin for I in Values do Result.Push(I); end; // ------------------------------------------------------------------------- procedure TestEmptyState(); var A: TIntArray; begin AssertTrue(A.IsEmpty, 'TestEmptyState: new array should be empty'); AssertFalse(A.IsNotEmpty, 'TestEmptyState: new array IsNotEmpty should be false'); AssertEquals(Integer(A.Length), 0, 'TestEmptyState: new array Length should be 0'); end; // ------------------------------------------------------------------------- procedure TestPushAndLength(); var A: TIntArray; I: Integer; begin for I := 1 to 10 do begin A.Push(I); AssertEquals(Integer(A.Length), I, 'TestPushAndLength: length after push ' + IntToStr(I)); end; AssertFalse(A.IsEmpty, 'TestPushAndLength: should not be empty after pushes'); AssertTrue(A.IsNotEmpty, 'TestPushAndLength: IsNotEmpty should be true after pushes'); end; // ------------------------------------------------------------------------- procedure TestPopBasic(); var A: TIntArray; V: Integer; begin A.Push(42); A.Push(99); V := A.Pop(); AssertEquals(V, 99, 'TestPopBasic: popped wrong value'); AssertEquals(Integer(A.Length), 1, 'TestPopBasic: length after pop'); V := A.Pop(); AssertEquals(V, 42, 'TestPopBasic: popped wrong value (second pop)'); AssertTrue(A.IsEmpty, 'TestPopBasic: should be empty after popping all'); end; // ------------------------------------------------------------------------- procedure TestEmptyProcedure(); var A: TIntArray; begin A.Push(1); A.Push(2); A.Push(3); A.Empty(); AssertTrue(A.IsEmpty, 'TestEmptyProcedure: should be empty after Empty()'); AssertEquals(Integer(A.Length), 0, 'TestEmptyProcedure: Length should be 0 after Empty()'); end; // ------------------------------------------------------------------------- procedure TestItemsReadWrite(); var A: TIntArray; I: Integer; begin for I := 0 to 9 do A.Push(I * 10); // $R- for I := 0 to 9 do AssertEquals(A[I], I * 10, 'TestItemsReadWrite: read item[' + IntToStr(I) + ']'); // $R- for I := 0 to 9 do A[I] := I * 100; // $R- for I := 0 to 9 do AssertEquals(A[I], I * 100, 'TestItemsReadWrite: read after write item[' + IntToStr(I) + ']'); // $R- end; // ------------------------------------------------------------------------- procedure TestLastProperty(); var A: TIntArray; begin A.Push(1); A.Push(2); A.Push(3); AssertEquals(A.Last, 3, 'TestLastProperty: Last should be 3'); A.Last := 99; AssertEquals(A.Last, 99, 'TestLastProperty: Last after write should be 99'); AssertEquals(Integer(A.Length), 3, 'TestLastProperty: Length should not change after Last write'); end; // ------------------------------------------------------------------------- procedure TestSetLength(); var A: TIntArray; I: Integer; begin A.Length := 5; AssertEquals(Integer(A.Length), 5, 'TestSetLength: length after set'); A.Length := 10; AssertEquals(Integer(A.Length), 10, 'TestSetLength: length after grow'); A.Length := 3; AssertEquals(Integer(A.Length), 3, 'TestSetLength: length after shrink'); for I := 1 to 5 do A.Push(I); AssertEquals(Integer(A.Length), 8, 'TestSetLength: length after push following shrink'); end; // ------------------------------------------------------------------------- procedure TestPrepareAndGrowFor(); var A: TIntArray; I, V, Count: Integer; Before, After: TFPCHeapStatus; begin // Verify Prepare allows subsequent pushes without reallocation A.Prepare(20); Before := GetFPCHeapStatus(); for I := 1 to 20 do A.Push(I); After := GetFPCHeapStatus(); AssertTrue(After.CurrHeapUsed = Before.CurrHeapUsed, 'TestPrepareAndGrowFor: Prepare(20) should prevent reallocation during 20 pushes'); AssertEquals(Integer(A.Length), 20, 'TestPrepareAndGrowFor: length after pushing 20 items following Prepare(20)'); Count := 0; for V in A do begin Inc(Count); AssertEquals(V, Count, 'TestPrepareAndGrowFor: value at position ' + IntToStr(Count)); end; AssertEquals(Count, 20, 'TestPrepareAndGrowFor: enumerated 20 items after Prepare'); // Verify GrowFor allows subsequent pushes without reallocation A.Empty(); A.GrowFor(15); Before := GetFPCHeapStatus(); for I := 1 to 15 do A.Push(I); After := GetFPCHeapStatus(); AssertTrue(After.CurrHeapUsed = Before.CurrHeapUsed, 'TestPrepareAndGrowFor: GrowFor(15) should prevent reallocation during 15 pushes'); AssertEquals(Integer(A.Length), 15, 'TestPrepareAndGrowFor: length after pushing 15 items following GrowFor(15)'); Count := 0; for V in A do begin Inc(Count); AssertEquals(V, Count, 'TestPrepareAndGrowFor: value at position ' + IntToStr(Count)); end; AssertEquals(Count, 15, 'TestPrepareAndGrowFor: enumerated 15 items after GrowFor'); // Verify GrowFor is additive: existing items plus new ones fit without reallocation A.Empty(); for I := 1 to 5 do A.Push(I); A.GrowFor(10); Before := GetFPCHeapStatus(); for I := 6 to 15 do A.Push(I); After := GetFPCHeapStatus(); AssertTrue(After.CurrHeapUsed = Before.CurrHeapUsed, 'TestPrepareAndGrowFor: GrowFor(10) with 5 existing items should prevent reallocation during 10 more pushes'); AssertEquals(Integer(A.Length), 15, 'TestPrepareAndGrowFor: length after GrowFor with existing items'); // Verify Prepare is idempotent: calling it again with a smaller value does not shrink A.Empty(); A.Prepare(20); A.Prepare(5); Before := GetFPCHeapStatus(); for I := 1 to 20 do A.Push(I); After := GetFPCHeapStatus(); AssertTrue(After.CurrHeapUsed = Before.CurrHeapUsed, 'TestPrepareAndGrowFor: Prepare(5) after Prepare(20) should not shrink capacity'); AssertEquals(Integer(A.Length), 20, 'TestPrepareAndGrowFor: length after idempotent Prepare'); // Verify Squeeze followed by Prepare re-establishes the no-reallocation guarantee A.Empty(); A.Squeeze(); A.Prepare(10); Before := GetFPCHeapStatus(); for I := 1 to 10 do A.Push(I); After := GetFPCHeapStatus(); AssertTrue(After.CurrHeapUsed = Before.CurrHeapUsed, 'TestPrepareAndGrowFor: Prepare(10) after Squeeze should prevent reallocation during 10 pushes'); AssertEquals(Integer(A.Length), 10, 'TestPrepareAndGrowFor: length after Squeeze+Prepare'); end; // ------------------------------------------------------------------------- procedure TestSqueeze(); var A: TIntArray; I: Integer; begin for I := 1 to 100 do A.Push(I); A.Empty(); A.Squeeze(); AssertTrue(A.IsEmpty, 'TestSqueeze: should still be empty after Squeeze'); A.Push(7); AssertEquals(Integer(A.Length), 1, 'TestSqueeze: can push after squeeze'); AssertEquals(A[0], 7, 'TestSqueeze: value after squeeze+push'); end; // ------------------------------------------------------------------------- procedure TestInsertAt(); var A: TIntArray; begin A := MakeIntArray([1, 2, 3, 4, 5]); A.InsertAt(2, 99); AssertEquals(Integer(A.Length), 6, 'TestInsertAt: length after insert'); AssertEquals(A[0], 1, 'TestInsertAt: [0]'); AssertEquals(A[1], 2, 'TestInsertAt: [1]'); AssertEquals(A[2], 99, 'TestInsertAt: [2] should be inserted value'); AssertEquals(A[3], 3, 'TestInsertAt: [3] shifted'); AssertEquals(A[4], 4, 'TestInsertAt: [4] shifted'); AssertEquals(A[5], 5, 'TestInsertAt: [5] shifted'); A.InsertAt(0, 0); AssertEquals(A[0], 0, 'TestInsertAt: insert at [0]'); AssertEquals(Integer(A.Length), 7, 'TestInsertAt: length after insert at 0'); A.InsertAt(A.Length, 100); AssertEquals(A[A.Length - 1], 100, 'TestInsertAt: insert at end'); // $R- end; // ------------------------------------------------------------------------- procedure TestInsertAtBoundaries(); var A: TIntArray; begin A.Push(5); A.InsertAt(0, 1); AssertEquals(Integer(A.Length), 2, 'TestInsertAtBoundaries: length'); AssertEquals(A[0], 1, 'TestInsertAtBoundaries: new first'); AssertEquals(A[1], 5, 'TestInsertAtBoundaries: shifted'); end; // ------------------------------------------------------------------------- procedure TestRemoveAt(); var A: TIntArray; begin A := MakeIntArray([10, 20, 30, 40, 50]); A.RemoveAt(2); AssertEquals(Integer(A.Length), 4, 'TestRemoveAt: length after remove'); AssertEquals(A[0], 10, 'TestRemoveAt: [0]'); AssertEquals(A[1], 20, 'TestRemoveAt: [1]'); AssertEquals(A[2], 40, 'TestRemoveAt: [2] shifted'); AssertEquals(A[3], 50, 'TestRemoveAt: [3] shifted'); A.RemoveAt(0); AssertEquals(A[0], 20, 'TestRemoveAt: remove first'); AssertEquals(Integer(A.Length), 3, 'TestRemoveAt: length after remove first'); A.RemoveAt(A.Length - 1); // $R- AssertEquals(Integer(A.Length), 2, 'TestRemoveAt: length after remove last'); AssertEquals(A[A.Length - 1], 40, 'TestRemoveAt: last after remove last'); // $R- end; // ------------------------------------------------------------------------- procedure TestRemoveAtAllElements(); var A: TIntArray; begin A := MakeIntArray([42]); A.RemoveAt(0); AssertTrue(A.IsEmpty, 'TestRemoveAtAllElements: empty after removing sole element'); end; // ------------------------------------------------------------------------- procedure TestRemove(); var A: TIntArray; begin A := MakeIntArray([1, 2, 3, 2, 4]); A.Remove(2); AssertEquals(Integer(A.Length), 4, 'TestRemove: length after remove'); AssertEquals(A[0], 1, 'TestRemove: [0]'); AssertEquals(A[1], 2, 'TestRemove: [1] should still be present (first occurrence)'); AssertEquals(A[2], 3, 'TestRemove: [2]'); AssertEquals(A[3], 4, 'TestRemove: [3]'); A.Remove(99); AssertEquals(Integer(A.Length), 4, 'TestRemove: length unchanged for absent value'); end; // ------------------------------------------------------------------------- procedure TestRemoveAll(); var A: TIntArray; begin A := MakeIntArray([1, 2, 1, 2, 1]); A.RemoveAll(1); AssertEquals(Integer(A.Length), 2, 'TestRemoveAll: length after RemoveAll'); AssertEquals(A[0], 2, 'TestRemoveAll: [0]'); AssertEquals(A[1], 2, 'TestRemoveAll: [1]'); A.RemoveAll(99); AssertEquals(Integer(A.Length), 2, 'TestRemoveAll: unchanged for absent value'); A.RemoveAll(2); AssertTrue(A.IsEmpty, 'TestRemoveAll: empty after removing all items'); end; // ------------------------------------------------------------------------- procedure TestRemoveAllTrailing(); var A: TIntArray; begin A := MakeIntArray([1, 2, 3, 0, 0, 0]); A.RemoveAllTrailing(0); AssertEquals(Integer(A.Length), 3, 'TestRemoveAllTrailing: length after removing trailing zeros'); AssertEquals(A[0], 1, 'TestRemoveAllTrailing: [0]'); AssertEquals(A[1], 2, 'TestRemoveAllTrailing: [1]'); AssertEquals(A[2], 3, 'TestRemoveAllTrailing: [2]'); A.RemoveAllTrailing(99); AssertEquals(Integer(A.Length), 3, 'TestRemoveAllTrailing: no trailing match'); A := MakeIntArray([0, 0, 0]); A.RemoveAllTrailing(0); AssertTrue(A.IsEmpty, 'TestRemoveAllTrailing: all trailing removed'); A := MakeIntArray([0, 1, 0, 0]); A.RemoveAllTrailing(0); AssertEquals(Integer(A.Length), 2, 'TestRemoveAllTrailing: stops at non-matching'); AssertEquals(A[0], 0, 'TestRemoveAllTrailing: leading zero preserved'); AssertEquals(A[1], 1, 'TestRemoveAllTrailing: middle preserved'); end; // ------------------------------------------------------------------------- procedure TestReplace(); var A: TIntArray; begin A := MakeIntArray([1, 2, 3, 2, 4]); A.Replace(2, 99); AssertEquals(Integer(A.Length), 5, 'TestReplace: length unchanged'); AssertEquals(A[0], 1, 'TestReplace: [0]'); AssertEquals(A[1], 2, 'TestReplace: [1] first occurrence still present'); AssertEquals(A[2], 3, 'TestReplace: [2]'); AssertEquals(A[3], 99, 'TestReplace: [3] last occurrence replaced'); AssertEquals(A[4], 4, 'TestReplace: [4]'); A.Replace(77, 88); AssertEquals(Integer(A.Length), 5, 'TestReplace: length unchanged for absent value'); end; // ------------------------------------------------------------------------- procedure TestContains(); var A: TIntArray; Idx: Cardinal; begin A := MakeIntArray([10, 20, 30, 40, 50]); AssertTrue(A.Contains(30), 'TestContains: should contain 30'); AssertFalse(A.Contains(99), 'TestContains: should not contain 99'); AssertTrue(A.Contains(30, Idx), 'TestContains: Contains with index should return true for 30'); AssertEquals(Integer(Idx), 2, 'TestContains: index of 30 should be 2'); AssertFalse(A.Contains(99, Idx), 'TestContains: Contains with index should return false for 99'); end; // ------------------------------------------------------------------------- procedure TestRemoveShiftLeftInsert(); var A: TIntArray; begin A := MakeIntArray([1, 2, 3, 4, 5]); A.RemoveShiftLeftInsert(1, 3, 99); AssertEquals(Integer(A.Length), 5, 'TestRemoveShiftLeftInsert: length unchanged'); AssertEquals(A[0], 1, 'TestRemoveShiftLeftInsert: [0]'); AssertEquals(A[1], 3, 'TestRemoveShiftLeftInsert: [1]'); AssertEquals(A[2], 4, 'TestRemoveShiftLeftInsert: [2]'); AssertEquals(A[3], 99, 'TestRemoveShiftLeftInsert: [3]'); AssertEquals(A[4], 5, 'TestRemoveShiftLeftInsert: [4]'); A := MakeIntArray([1, 2, 3]); A.RemoveShiftLeftInsert(1, 1, 99); AssertEquals(Integer(A.Length), 3, 'TestRemoveShiftLeftInsert: identity length'); AssertEquals(A[0], 1, 'TestRemoveShiftLeftInsert: identity [0]'); AssertEquals(A[1], 99, 'TestRemoveShiftLeftInsert: identity [1]'); AssertEquals(A[2], 3, 'TestRemoveShiftLeftInsert: identity [2]'); end; // ------------------------------------------------------------------------- procedure TestDistill(); var A: TIntArray; D: array of Integer; I, V: Integer; begin for I := 1 to 5 do A.Push(I * 11); // $R- D := A.Distill(); AssertTrue(A.IsEmpty, 'TestDistill: PlasticArray should be empty after Distill'); AssertEquals(System.Length(D), 5, 'TestDistill: distilled array length'); // $R- I := 0; for V in D do begin AssertEquals(V, (I + 1) * 11, 'TestDistill: distilled[' + IntToStr(I) + ']'); // $R- Inc(I); end; end; // ------------------------------------------------------------------------- procedure TestCopy(); var A: TIntArray; C: array of Integer; I, V: Integer; begin for I := 1 to 5 do A.Push(I); C := A.Copy(); AssertEquals(Integer(A.Length), 5, 'TestCopy: original length unchanged'); AssertEquals(System.Length(C), 5, 'TestCopy: copied array length'); // $R- I := 0; for V in C do begin AssertEquals(V, I + 1, 'TestCopy: copied[' + IntToStr(I) + ']'); // $R- Inc(I); end; end; // ------------------------------------------------------------------------- procedure TestSortWithCompareFunc(); var A: TIntArray; Prev, V: Integer; begin A := MakeIntArray([5, 3, 1, 4, 2]); A.Sort(@IntAscending); AssertEquals(Integer(A.Length), 5, 'TestSortWithCompareFunc: length preserved'); Prev := A[0]; for V in A do begin AssertTrue(Prev <= V, 'TestSortWithCompareFunc: not sorted ascending'); Prev := V; end; A.Sort(@IntDescending); Prev := A[0]; for V in A do begin AssertTrue(Prev >= V, 'TestSortWithCompareFunc: not sorted descending'); Prev := V; end; end; // ------------------------------------------------------------------------- procedure TestSortDefault(); var A: TIntArray; Prev, V: Integer; begin A := MakeIntArray([9, 1, 5, 3, 7, 2, 8, 4, 6, 0]); A.Sort(); AssertEquals(Integer(A.Length), 10, 'TestSortDefault: length preserved'); Prev := A[0]; for V in A do begin AssertTrue(Prev <= V, 'TestSortDefault: not sorted'); Prev := V; end; end; // ------------------------------------------------------------------------- procedure TestSortAlreadySorted(); var A: TIntArray; Prev, V: Integer; begin A := MakeIntArray([1, 2, 3, 4, 5]); A.Sort(); Prev := A[0]; for V in A do begin AssertTrue(Prev <= V, 'TestSortAlreadySorted: not sorted'); Prev := V; end; end; // ------------------------------------------------------------------------- procedure TestSortReversed(); var A: TIntArray; Prev, V: Integer; begin A := MakeIntArray([5, 4, 3, 2, 1]); A.Sort(); Prev := A[0]; for V in A do begin AssertTrue(Prev <= V, 'TestSortReversed: not sorted'); Prev := V; end; end; // ------------------------------------------------------------------------- procedure TestSortDuplicates(); var A: TIntArray; Prev, V: Integer; begin A := MakeIntArray([3, 1, 2, 1, 3, 2]); A.Sort(); AssertEquals(Integer(A.Length), 6, 'TestSortDuplicates: length preserved'); Prev := A[0]; for V in A do begin AssertTrue(Prev <= V, 'TestSortDuplicates: not sorted'); Prev := V; end; end; // ------------------------------------------------------------------------- procedure TestSortSingleElement(); var A: TIntArray; begin A.Push(42); A.Sort(); AssertEquals(Integer(A.Length), 1, 'TestSortSingleElement: length'); AssertEquals(A[0], 42, 'TestSortSingleElement: value preserved'); end; // ------------------------------------------------------------------------- procedure TestSortSubrange(); var A: TIntArray; begin A := MakeIntArray([5, 3, 1, 4, 2]); A.SortSubrange(1, 3); AssertEquals(A[0], 5, 'TestSortSubrange: [0] outside range unchanged'); AssertEquals(A[4], 2, 'TestSortSubrange: [4] outside range unchanged'); AssertTrue(A[1] <= A[2], 'TestSortSubrange: [1]<=[2]'); AssertTrue(A[2] <= A[3], 'TestSortSubrange: [2]<=[3]'); end; // ------------------------------------------------------------------------- procedure TestSortSubrangeWithFunc(); var A: TIntArray; begin A := MakeIntArray([5, 3, 1, 4, 2]); A.SortSubrange(1, 3, @IntAscending); AssertEquals(A[0], 5, 'TestSortSubrangeWithFunc: [0] outside range unchanged'); AssertEquals(A[4], 2, 'TestSortSubrangeWithFunc: [4] outside range unchanged'); AssertTrue(A[1] <= A[2], 'TestSortSubrangeWithFunc: [1]<=[2]'); AssertTrue(A[2] <= A[3], 'TestSortSubrangeWithFunc: [2]<=[3]'); end; // ------------------------------------------------------------------------- procedure TestSortStability(); var A: TIntArray; Ones, Twos, Threes, V: Integer; begin A := MakeIntArray([2, 1, 3, 1, 2, 3, 1, 2, 3]); A.Sort(); Ones := 0; Twos := 0; Threes := 0; for V in A do case V of 1: Inc(Ones); 2: Inc(Twos); 3: Inc(Threes); else Fail('TestSortStability: unexpected value ' + IntToStr(V)); end; AssertEquals(Ones, 3, 'TestSortStability: three 1s'); AssertEquals(Twos, 3, 'TestSortStability: three 2s'); AssertEquals(Threes, 3, 'TestSortStability: three 3s'); end; // ------------------------------------------------------------------------- procedure TestShuffle(); var A: TIntArray; I, Sum, Prev, V: Integer; begin for I := 0 to 99 do A.Push(I); A.Shuffle(); AssertEquals(Integer(A.Length), 100, 'TestShuffle: length preserved'); Sum := 0; for V in A do Sum := Sum + V; // $R- AssertEquals(Sum, 4950, 'TestShuffle: sum of shuffled elements must equal sum of original'); A.Sort(); Prev := A[0]; for V in A do begin AssertTrue(Prev <= V, 'TestShuffle: not sorted after sort post-shuffle'); Prev := V; end; end; // ------------------------------------------------------------------------- procedure TestFind(); var A: TIntArray; Idx: Cardinal; begin A := MakeIntArray([1, 3, 5, 7, 9, 11, 13]); Idx := A.Find(1); AssertEquals(Integer(Idx), 0, 'TestFind: Find(1)'); Idx := A.Find(7); AssertEquals(Integer(Idx), 3, 'TestFind: Find(7)'); Idx := A.Find(13); AssertEquals(Integer(Idx), 6, 'TestFind: Find(13)'); A.Empty(); A.Push(42); Idx := A.Find(42); AssertEquals(Integer(Idx), 0, 'TestFind: Find in single-element array'); end; // ------------------------------------------------------------------------- procedure TestEnumerator(); var A: TIntArray; I, Sum: Integer; begin for I := 1 to 5 do A.Push(I); Sum := 0; for I in A do Sum := Sum + I; // $R- AssertEquals(Sum, 15, 'TestEnumerator: sum via for-in'); A.Empty(); Sum := 0; for I in A do Sum := Sum + I; // $R- AssertEquals(Sum, 0, 'TestEnumerator: sum over empty array'); end; // ------------------------------------------------------------------------- procedure TestEnumeratorLiveMutationAppend(); var A: TIntArray; V: Integer; begin A.Push(1); A.Push(2); A.Push(3); // While enumerating, append new items beyond the current position. // The spec guarantees this is safe. Each value <= 6 causes its double // to be appended, so the sequence grows: // Visit 1 (<=6): append 2 -> [1,2,3,2] // Visit 2 (<=6): append 4 -> [1,2,3,2,4] // Visit 3 (<=6): append 6 -> [1,2,3,2,4,6] // Visit 2 (<=6): append 4 -> [1,2,3,2,4,6,4] // Visit 4 (<=6): append 8 -> [1,2,3,2,4,6,4,8] // Visit 6 (<=6): append 12 -> [1,2,3,2,4,6,4,8,12] // Visit 4 (<=6): append 8 -> [1,2,3,2,4,6,4,8,12,8] // Visit 8 (>6): no append // Visit 12 (>6): no append // Visit 8 (>6): no append for V in A do if V <= 6 then A.Push(V * 2); // $R- AssertEquals(Integer(A.Length), 10, 'TestEnumeratorLiveMutationAppend: length after live appends'); AssertEquals(A[0], 1, 'TestEnumeratorLiveMutationAppend: [0]'); AssertEquals(A[1], 2, 'TestEnumeratorLiveMutationAppend: [1]'); AssertEquals(A[2], 3, 'TestEnumeratorLiveMutationAppend: [2]'); AssertEquals(A[3], 2, 'TestEnumeratorLiveMutationAppend: [3] appended from 1'); AssertEquals(A[4], 4, 'TestEnumeratorLiveMutationAppend: [4] appended from 2'); AssertEquals(A[5], 6, 'TestEnumeratorLiveMutationAppend: [5] appended from 3'); AssertEquals(A[6], 4, 'TestEnumeratorLiveMutationAppend: [6] appended from 2'); AssertEquals(A[7], 8, 'TestEnumeratorLiveMutationAppend: [7] appended from 4'); AssertEquals(A[8], 12, 'TestEnumeratorLiveMutationAppend: [8] appended from 6'); AssertEquals(A[9], 8, 'TestEnumeratorLiveMutationAppend: [9] appended from 4'); end; // ------------------------------------------------------------------------- procedure TestCopyOnWrite(); var A, B: TIntArray; I: Integer; begin for I := 1 to 5 do A.Push(I); B := A; B[0] := 99; AssertEquals(A[0], 1, 'TestCopyOnWrite: A[0] must not be affected by write to B'); AssertEquals(B[0], 99, 'TestCopyOnWrite: B[0] should be 99'); AssertEquals(Integer(A.Length), 5, 'TestCopyOnWrite: A length unchanged'); AssertEquals(Integer(B.Length), 5, 'TestCopyOnWrite: B length unchanged'); end; // ------------------------------------------------------------------------- procedure TestCopyOnWritePush(); var A, B: TIntArray; begin A.Push(1); A.Push(2); B := A; B.Push(3); AssertEquals(Integer(A.Length), 2, 'TestCopyOnWritePush: A length should remain 2'); AssertEquals(Integer(B.Length), 3, 'TestCopyOnWritePush: B length should be 3'); end; // ------------------------------------------------------------------------- procedure TestCopyOnWriteMultipleRefs(); var A, B, C: TIntArray; begin A.Push(10); A.Push(20); B := A; C := A; C[0] := 77; AssertEquals(A[0], 10, 'TestCopyOnWriteMultipleRefs: A[0] unchanged'); AssertEquals(B[0], 10, 'TestCopyOnWriteMultipleRefs: B[0] unchanged'); AssertEquals(C[0], 77, 'TestCopyOnWriteMultipleRefs: C[0] is 77'); end; // ------------------------------------------------------------------------- procedure TestPushPopRoundTrip(); var A: TIntArray; I, V: Integer; begin for I := 1 to 20 do A.Push(I); for I := 20 downto 1 do begin V := A.Pop(); AssertEquals(V, I, 'TestPushPopRoundTrip: pop at step ' + IntToStr(21 - I)); end; AssertTrue(A.IsEmpty, 'TestPushPopRoundTrip: empty after full pop round-trip'); end; // ------------------------------------------------------------------------- procedure TestStringArray(); var A: TStrArray; Idx: Cardinal; Found: Boolean; V: AnsiString; begin A.Push('banana'); A.Push('apple'); A.Push('cherry'); AssertEquals(Integer(A.Length), 3, 'TestStringArray: length'); AssertEquals(A[0], 'banana', 'TestStringArray: [0]'); AssertEquals(A[1], 'apple', 'TestStringArray: [1]'); A.Sort(); AssertEquals(A[0], 'apple', 'TestStringArray: sorted [0]'); AssertEquals(A[1], 'banana', 'TestStringArray: sorted [1]'); AssertEquals(A[2], 'cherry', 'TestStringArray: sorted [2]'); Found := A.Contains('banana', Idx); AssertTrue(Found, 'TestStringArray: Contains banana'); AssertEquals(Integer(Idx), 1, 'TestStringArray: banana index after sort'); Idx := A.Find('cherry'); AssertEquals(Integer(Idx), 2, 'TestStringArray: Find cherry'); V := ''; for V in A do ; AssertEquals(V, 'cherry', 'TestStringArray: last element via for-in'); end; // ------------------------------------------------------------------------- procedure TestLargeDataset(); var A: TIntArray; I, Prev, V: Integer; begin for I := 1 to 100000 do A.Push(I); AssertEquals(Integer(A.Length), 100000, 'TestLargeDataset: length after 100k pushes'); AssertEquals(A[0], 1, 'TestLargeDataset: first element'); AssertEquals(A[99999], 100000, 'TestLargeDataset: last element'); A.Sort(); Prev := A[0]; for V in A do begin AssertTrue(Prev <= V, 'TestLargeDataset: not sorted'); Prev := V; end; end; // ------------------------------------------------------------------------- procedure TestLifecyclePush(); var A: TTrackedArray; Item: TTracked; Cursor: Integer; begin // Prepare exactly 1 slot so the push does not reallocate, ensuring // the log contains only the events for the single push operation. A.Prepare(1); Item.Value := 42; ResetLog(); A.Push(Item); // Expected sequence: Initialize the new slot, then Copy the value into it. Cursor := 0; AssertNextEvent(Cursor, leInitialize, 'TestLifecyclePush: slot must be initialized before copy'); AssertNextEvent(Cursor, leCopy, 'TestLifecyclePush: value must be copied into initialized slot'); AssertNoMoreEvents(Cursor, 'TestLifecyclePush'); end; // ------------------------------------------------------------------------- procedure TestLifecyclePop(); var A: TTrackedArray; Item, Popped: TTracked; Cursor: Integer; begin Item.Value := 7; A.Push(Item); ResetLog(); Popped := A.Pop(); // Expected: Copy the slot value into the result, then Finalize the vacated slot. Cursor := 0; AssertNextEvent(Cursor, leCopy, 'TestLifecyclePop: value must be copied out before finalize'); AssertNextEvent(Cursor, leFinalize, 'TestLifecyclePop: vacated slot must be finalized after pop'); AssertNoMoreEvents(Cursor, 'TestLifecyclePop'); AssertEquals(Popped.Value, 7, 'TestLifecyclePop: popped value must be correct'); end; // ------------------------------------------------------------------------- procedure TestLifecycleEmpty(); var A: TTrackedArray; Item: TTracked; I: Integer; begin Item.Value := 1; for I := 1 to 4 do A.Push(Item); ResetLog(); A.Empty(); AssertEquals(CountEvents(leFinalize), 4, 'TestLifecycleEmpty: must Finalize all 4 slots'); end; // ------------------------------------------------------------------------- procedure TestLifecycleSetLengthGrow(); var A: TTrackedArray; Item: TTracked; Cursor: Integer; begin // Prepare(4) guarantees the backing store already holds 4 slots, so // changing Length from 1 to 4 will not reallocate and will produce // exactly 3 Initialize events — one per newly filled slot. A.Prepare(4); Item.Value := 1; A.Push(Item); ResetLog(); A.Length := 4; Cursor := 0; AssertNextEvent(Cursor, leInitialize, 'TestLifecycleSetLengthGrow: first new slot initialized'); AssertNextEvent(Cursor, leInitialize, 'TestLifecycleSetLengthGrow: second new slot initialized'); AssertNextEvent(Cursor, leInitialize, 'TestLifecycleSetLengthGrow: third new slot initialized'); AssertNoMoreEvents(Cursor, 'TestLifecycleSetLengthGrow'); AssertEquals(Integer(A.Length), 4, 'TestLifecycleSetLengthGrow: length must be 4 after grow'); AssertEquals(A[0].Value, 1, 'TestLifecycleSetLengthGrow: existing slot value must be preserved'); end; // ------------------------------------------------------------------------- procedure TestLifecycleSetLengthShrink(); var A: TTrackedArray; Item: TTracked; I: Integer; begin Item.Value := 1; for I := 1 to 4 do A.Push(Item); ResetLog(); A.Length := 1; // shrink by 3 // Exactly 3 slots must be finalized. The implementation may or may not // reallocate, so we do not assert anything about Initialize or Copy events. AssertEquals(CountEvents(leFinalize), 3, 'TestLifecycleSetLengthShrink: must Finalize 3 removed slots'); AssertEquals(Integer(A.Length), 1, 'TestLifecycleSetLengthShrink: length must be 1 after shrink'); AssertEquals(A[0].Value, 1, 'TestLifecycleSetLengthShrink: remaining slot value must be preserved'); end; // ------------------------------------------------------------------------- procedure TestLifecycleRemoveAt(); var A: TTrackedArray; Item: TTracked; I: Integer; begin for I := 1 to 3 do begin Item.Value := I; A.Push(Item); end; ResetLog(); A.RemoveAt(1); AssertEquals(CountEvents(leFinalize), 1, 'TestLifecycleRemoveAt: must Finalize exactly the removed slot'); AssertEquals(Integer(A.Length), 2, 'TestLifecycleRemoveAt: length must be 2 after remove'); AssertEquals(A[0].Value, 1, 'TestLifecycleRemoveAt: [0] must be preserved'); AssertEquals(A[1].Value, 3, 'TestLifecycleRemoveAt: [1] must be shifted value'); end; // ------------------------------------------------------------------------- procedure TestLifecycleInsertAt(); var A: TTrackedArray; Item: TTracked; I, Cursor: Integer; begin // Prepare(4) guarantees capacity for 4 items, so inserting a fourth // item will not reallocate and the log will contain exactly the events // for opening the new slot, shifting, and writing the new value. A.Prepare(4); for I := 1 to 3 do begin Item.Value := I; A.Push(Item); end; Item.Value := 99; ResetLog(); A.InsertAt(1, Item); // The new slot at the end of the array is initialized first, then the // two items at indices 1 and 2 are copied rightward into it and the // adjacent slot, then the new value is copied into the now-vacated // slot at index 1. Cursor := 0; AssertNextEvent(Cursor, leInitialize, 'TestLifecycleInsertAt: new slot at end must be initialized'); AssertNextEvent(Cursor, leCopy, 'TestLifecycleInsertAt: first shifted item copied'); AssertNextEvent(Cursor, leCopy, 'TestLifecycleInsertAt: second shifted item copied'); AssertNextEvent(Cursor, leCopy, 'TestLifecycleInsertAt: new value copied into slot'); AssertNoMoreEvents(Cursor, 'TestLifecycleInsertAt'); AssertEquals(Integer(A.Length), 4, 'TestLifecycleInsertAt: length after insert'); AssertEquals(A[0].Value, 1, 'TestLifecycleInsertAt: [0] unchanged'); AssertEquals(A[1].Value, 99, 'TestLifecycleInsertAt: [1] inserted value'); AssertEquals(A[2].Value, 2, 'TestLifecycleInsertAt: [2] shifted'); AssertEquals(A[3].Value, 3, 'TestLifecycleInsertAt: [3] shifted'); end; // ------------------------------------------------------------------------- procedure TestLifecycleSqueeze(); var A: TTrackedArray; Item: TTracked; I: Cardinal; begin // Prepare(10) gives a backing store of 10 slots; push 3 items to fill // slots 0-2, leaving slots 3-9 as raw uninitialized excess capacity. A.Prepare(10); Item.Value := 1; for I := 1 to 3 do A.Push(Item); ResetLog(); A.Squeeze(); // Squeeze allocates a new backing store sized exactly to the filled // length (3), initializes its 3 slots, copies the 3 filled items // across, then finalizes the 3 filled slots in the old backing store. // The 7 excess capacity slots in the old store are raw memory and are // never initialized, so they must not be finalized. AssertEquals(CountEvents(leInitialize), 3, 'TestLifecycleSqueeze: must Initialize 3 slots in new store'); AssertEquals(CountEvents(leCopy), 3, 'TestLifecycleSqueeze: must Copy 3 items to new store'); AssertEquals(CountEvents(leFinalize), 3, 'TestLifecycleSqueeze: must Finalize 3 slots in old store'); AssertEquals(Integer(A.Length), 3, 'TestLifecycleSqueeze: filled length must be preserved'); for I := 0 to 2 do AssertEquals(A[I].Value, 1, 'TestLifecycleSqueeze: slot ' + IntToStr(I) + ' value must be preserved'); end; // ------------------------------------------------------------------------- procedure TestLifecycleCopyOnWrite(); var A, B: TTrackedArray; Item: TTracked; I: Integer; begin for I := 1 to 3 do begin Item.Value := I; A.Push(Item); end; B := A; ResetLog(); // Trigger CoW by writing a whole item into B's first slot. Item.Value := 99; B[0] := Item; // CoW forks the backing store: a new store is allocated for B, // its slots are initialized, the filled items are copied across, // but A's slots must not be finalized since A still owns them. AssertEquals(CountEvents(leInitialize), 3, 'TestLifecycleCopyOnWrite: must Initialize 3 slots in new store'); AssertEquals(CountEvents(leCopy), 4, 'TestLifecycleCopyOnWrite: must Copy 3 items to new store'); AssertEquals(CountEvents(leFinalize), 0, 'TestLifecycleCopyOnWrite: must not Finalize any slots in original'); AssertEquals(A[0].Value, 1, 'TestLifecycleCopyOnWrite: original first slot value must be unchanged'); AssertEquals(B[0].Value, 99, 'TestLifecycleCopyOnWrite: B first slot must have new value'); end; // ========================================================================= // Dispatch // ========================================================================= begin TestEmptyState(); TestPushAndLength(); TestPopBasic(); TestEmptyProcedure(); TestItemsReadWrite(); TestLastProperty(); TestSetLength(); TestPrepareAndGrowFor(); TestSqueeze(); TestInsertAt(); TestInsertAtBoundaries(); TestRemoveAt(); TestRemoveAtAllElements(); TestRemove(); TestRemoveAll(); TestRemoveAllTrailing(); TestReplace(); TestContains(); TestRemoveShiftLeftInsert(); TestDistill(); TestCopy(); TestSortWithCompareFunc(); TestSortDefault(); TestSortAlreadySorted(); TestSortReversed(); TestSortDuplicates(); TestSortSingleElement(); TestSortSubrange(); TestSortSubrangeWithFunc(); TestSortStability(); TestShuffle(); TestFind(); TestEnumerator(); TestEnumeratorLiveMutationAppend(); TestCopyOnWrite(); TestCopyOnWritePush(); TestCopyOnWriteMultipleRefs(); TestPushPopRoundTrip(); TestStringArray(); TestLargeDataset(); TestLifecyclePush(); TestLifecyclePop(); TestLifecycleEmpty(); TestLifecycleSetLengthGrow(); TestLifecycleSetLengthShrink(); TestLifecycleRemoveAt(); TestLifecycleInsertAt(); TestLifecycleSqueeze(); TestLifecycleCopyOnWrite(); end;