freepascal.compiler/packages/rtl-generics/tests/tests.generics.utils.pas

unit tests.generics.utils;

{$mode delphi}

interface

uses
  fpcunit, testutils, testregistry,
  Classes, SysUtils, Generics.Collections;

type
  TNotificationRec<T> = record
    Sender: TObject;
    Item: T;
    Action: TCollectionNotification;
    Executed: boolean;
  end;

  TNotificationNodeRec<TValue, TInfo> = record
    Sender: TObject;
    Key: string;
    Value: TValue;
    IgnoreNodePtr: boolean;
    Node: TCustomAVLTreeMap<string, TValue, TInfo>.PNode;
    Action: TCollectionNotification;
    Dispose: boolean;
    Executed: boolean;
  end;

  TTestCollections = class(TTestCase)
  private type
    TNotificationRec_String = TNotificationRec<string>;
    TNotificationRec_TObject = TNotificationRec<TObject>;
    TNotificationNodeRec_String = TNotificationNodeRec<string, TEmptyRecord>;
    TNotificationNodeRec_Empty = TNotificationNodeRec<TEmptyRecord, TEmptyRecord>;
    PNode_String = TCustomAVLTreeMap<string, string, TEmptyRecord>.PNode;
    PNode_Empty = TCustomAVLTreeMap<string, TEmptyRecord, TEmptyRecord>.PNode;
  private
    NotificationsListNode_String: TList<TNotificationNodeRec_String>;
    NotificationsListNode_Empty: TList<TNotificationNodeRec_Empty>;
    NotificationsListStr: TList<TNotificationRec_String>;
    NotificationsListObj: TList<TNotificationRec_TObject>;
    NotificationsIndex, NotificationsNodesIndex: Integer;
  protected
    procedure NotificationAdd(ASender: TObject; const AKey, AValue: string; ANode: PNode_String;
      AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean); overload;
    procedure NotificationAdd(ASender: TObject; const AKeys, AValues: array of string;
      const ANodes: array of PNode_String; AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean); overload;
    procedure NotificationAdd(ASender: TObject; const AKey: string; ANode: PNode_Empty;
      AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean); overload;
    procedure NotificationAdd(ASender: TObject; const AKeys: array of string;
      const ANodes: array of PNode_Empty; AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean); overload;
    procedure NotificationAdd(ASender: TObject; const AItem: string;
      AAction: TCollectionNotification); overload;
    procedure NotificationAdd(ASender: TObject; const AItems: array of string;
      AAction: TCollectionNotification); overload;
    procedure NotificationAdd(ASender: TObject; const AItem: TObject;
      AAction: TCollectionNotification); overload;
    procedure NotificationAdd(ASender: TObject; const AItems: array of TObject;
      AAction: TCollectionNotification); overload;
    procedure AssertNotificationsExecutedNodeStr;
    procedure ClearNotificationsNodeStr;
    procedure AssertNotificationsExecutedNodeEmpty;
    procedure ClearNotificationsNodeEmpty;
    procedure AssertNotificationsExecutedStr;
    procedure ClearNotificationsStr;
    procedure AssertNotificationsExecutedObj;
    procedure ClearNotificationsObj;
    procedure NotifyTestNodeStr(ASender: TObject; ANode: PNode_String; AAction: TCollectionNotification; ADispose: boolean);
    procedure NotifyTestNodeEmpty(ASender: TObject; ANode: PNode_Empty; AAction: TCollectionNotification; ADispose: boolean);
    procedure NotifyTestStr(ASender: TObject; constref AItem: string; AAction: TCollectionNotification);
    procedure NotifyTestObj(ASender: TObject; constref AItem: TObject; AAction: TCollectionNotification);

    procedure CreateObjects(var AArray: TArray<TObject>; ACount: Integer);
    procedure FreeObjects(AArray: TArray<TObject>);
  public
    constructor Create; override;
    destructor Destroy; override;
  end;

  TStringList = TList<string>;

  { TStringsEnumerator }

  TStringsEnumerator = class(TInterfacedObject, IEnumerator<string>)
  private
    FEnumerator: TStringList.TEnumerator;
    FCollection: TStringList;

    function GetCurrent: string;
    function MoveNext: Boolean;
    procedure Reset;
    property Current: string read GetCurrent;

    constructor Create(AEnumerator: TStringList.TEnumerator; ACollection: TStringList);
    destructor Destroy; override;
  end;

  { TStringsEnumerable }

  TStringsEnumerable = class(TInterfacedObject, IEnumerable<string>)
  private
    FEnumerable: TStringList;

    function GetEnumerator: IEnumerator<string>;

    constructor Create(const AItems: array of string);
  end;

  TObjectList = TList<TObject>;

  { TObjectEnumerator }

  TObjectEnumerator = class(TInterfacedObject, IEnumerator<TObject>)
  private
    FEnumerator: TObjectList.TEnumerator;
    FCollection: TObjectList;

    function GetCurrent: TObject;
    function MoveNext: Boolean;
    procedure Reset;
    property Current: TObject read GetCurrent;

    constructor Create(AEnumerator: TObjectList.TEnumerator; ACollection: TObjectList);
    destructor Destroy; override;
  end;

  { TObjectEnumerable }

  TObjectEnumerable = class(TInterfacedObject, IEnumerable<TObject>)
  private
    FEnumerable: TObjectList;

    function GetEnumerator: IEnumerator<TObject>;

    constructor Create(const AItems: array of TObject);
  end;

function EnumerableStringsIntf(const AItems: array of string): IEnumerable<string>;
function EnumerableStringsObj(const AItems: array of string): TEnumerable<string>;
function EnumerableObjectsIntf(const AItems: array of TObject): IEnumerable<TObject>;
function EnumerableObjectsObj(const AItems: array of TObject): TEnumerable<TObject>;

implementation

function EnumerableStringsIntf(const AItems: array of string): IEnumerable<string>;
begin
  Result := TStringsEnumerable.Create(AItems);
end;

function EnumerableStringsObj(const AItems: array of string): TEnumerable<string>;
begin
  Result := TStringList.Create;
  TStringList(Result).AddRange(AItems);
end;

function EnumerableObjectsIntf(const AItems: array of TObject): IEnumerable<TObject>;
begin
  Result := TObjectEnumerable.Create(AItems);
end;

function EnumerableObjectsObj(const AItems: array of TObject): TEnumerable<TObject>;
begin
  Result := TObjectList.Create;
  TObjectList(Result).AddRange(AItems);
end;

{ TTestCollections }

procedure TTestCollections.NotificationAdd(ASender: TObject;
  const AKey, AValue: string; ANode: PNode_String; AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean);
var
  LNotification: TNotificationNodeRec_String;
begin
  LNotification.Sender := ASender;
  LNotification.Key := AKey;
  LNotification.Value := AValue;
  LNotification.IgnoreNodePtr := AIgnoreNodePtr;
  LNotification.Node := ANode;
  LNotification.Action := AAction;
  LNotification.Dispose := ADispose;
  LNotification.Executed := False;
  NotificationsListNode_String.Add(LNotification);
end;

procedure TTestCollections.NotificationAdd(ASender: TObject;
  const AKeys, AValues: array of string; const ANodes: array of PNode_String; AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean);
var
  i: Integer;
begin
  Assert(Length(AKeys) = Length(ANodes));
  for i := 0 to High(AKeys) do
    NotificationAdd(ASender, AKeys[i], AValues[i], ANodes[i], AAction, ADispose, AIgnoreNodePtr);
end;

procedure TTestCollections.NotificationAdd(ASender: TObject;
  const AKey: string; ANode: PNode_Empty; AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean);
var
  LNotification: TNotificationNodeRec_Empty;
begin
  LNotification.Sender := ASender;
  LNotification.Key := AKey;
  LNotification.Value := EmptyRecord;
  LNotification.IgnoreNodePtr := AIgnoreNodePtr;
  LNotification.Node := ANode;
  LNotification.Action := AAction;
  LNotification.Dispose := ADispose;
  LNotification.Executed := False;
  NotificationsListNode_Empty.Add(LNotification);
end;

procedure TTestCollections.NotificationAdd(ASender: TObject;
  const AKeys: array of string; const ANodes: array of PNode_Empty; AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean);
var
  i: Integer;
begin
  Assert(Length(AKeys) = Length(ANodes));
  for i := 0 to High(AKeys) do
    NotificationAdd(ASender, AKeys[i], ANodes[i], AAction, ADispose, AIgnoreNodePtr);
end;


procedure TTestCollections.NotificationAdd(ASender: TObject;
  const AItem: string; AAction: TCollectionNotification);
var
  LNotification: TNotificationRec_String;
begin
  LNotification.Sender := ASender;
  LNotification.Item := AItem;
  LNotification.Action := AAction;
  LNotification.Executed := False;
  NotificationsListStr.Add(LNotification);
end;

procedure TTestCollections.NotificationAdd(ASender: TObject;
  const AItems: array of string; AAction: TCollectionNotification);
var
  s: string;
begin
  for s in AItems do
    NotificationAdd(ASender, s, AAction);
end;

procedure TTestCollections.NotificationAdd(ASender: TObject;
  const AItem: TObject; AAction: TCollectionNotification);
var
  LNotification: TNotificationRec_TObject;
begin
  LNotification.Sender := ASender;
  LNotification.Item := AItem;
  LNotification.Action := AAction;
  LNotification.Executed := False;
  NotificationsListObj.Add(LNotification);
end;

procedure TTestCollections.NotificationAdd(ASender: TObject;
  const AItems: array of TObject; AAction: TCollectionNotification);
var
  o: TObject;
begin
  for o in AItems do
    NotificationAdd(ASender, o, AAction);
end;

procedure TTestCollections.AssertNotificationsExecutedNodeStr;
var
  p: ^TNotificationNodeRec_String;
begin
  for p in NotificationsListNode_String.Ptr^ do
    AssertTrue(p^.Executed);
  AssertEquals(NotificationsNodesIndex, NotificationsListNode_String.Count);
  ClearNotificationsStr;
end;

procedure TTestCollections.ClearNotificationsNodeStr;
begin
  NotificationsListNode_String.Clear;
  NotificationsNodesIndex := 0;
end;

procedure TTestCollections.AssertNotificationsExecutedNodeEmpty;
var
  p: ^TNotificationNodeRec_Empty;
begin
  for p in NotificationsListNode_Empty.Ptr^ do
    AssertTrue(p^.Executed);
  AssertEquals(NotificationsNodesIndex, NotificationsListNode_Empty.Count);
  ClearNotificationsStr;
end;

procedure TTestCollections.ClearNotificationsNodeEmpty;
begin
  NotificationsListNode_Empty.Clear;
  NotificationsNodesIndex := 0;
end;

procedure TTestCollections.AssertNotificationsExecutedStr;
var
  p: ^TNotificationRec_String;
begin
  for p in NotificationsListStr.Ptr^ do
    AssertTrue(p^.Executed);
  AssertEquals(NotificationsIndex, NotificationsListStr.Count);
  ClearNotificationsStr;
end;

procedure TTestCollections.ClearNotificationsStr;
begin
  NotificationsListStr.Clear;
  NotificationsIndex := 0;
end;

procedure TTestCollections.AssertNotificationsExecutedObj;
var
  p: ^TNotificationRec_TObject;
begin
  for p in NotificationsListObj.Ptr^ do
    AssertTrue(p^.Executed);
  AssertEquals(NotificationsIndex, NotificationsListObj.Count);
  ClearNotificationsObj;
end;

procedure TTestCollections.ClearNotificationsObj;
begin
  NotificationsListObj.Clear;
  NotificationsIndex := 0;
end;

procedure TTestCollections.NotifyTestNodeStr(ASender: TObject; ANode: PNode_String; AAction: TCollectionNotification; ADispose: boolean);
var
  LNotification: TNotificationNodeRec_String;
begin
  AssertTrue(NotificationsNodesIndex < NotificationsListNode_String.Count);
  LNotification := NotificationsListNode_String[NotificationsNodesIndex];
  AssertTrue(ASender = LNotification.Sender);
  AssertEquals(ANode.Key, LNotification.Key);
  AssertEquals(ANode.Value, LNotification.Value);
  if not LNotification.IgnoreNodePtr then
    AssertSame(ANode, LNotification.Node);
  AssertTrue(AAction = LNotification.Action);
  AssertEquals(ADispose, LNotification.Dispose);
  AssertFalse(LNotification.Executed);
  LNotification.Executed := True;
  NotificationsListNode_String[NotificationsNodesIndex] := LNotification;
  Inc(NotificationsNodesIndex)
end;

procedure TTestCollections.NotifyTestNodeEmpty(ASender: TObject; ANode: PNode_Empty; AAction: TCollectionNotification; ADispose: boolean);
var
  LNotification: TNotificationNodeRec_Empty;
begin
  AssertTrue(NotificationsNodesIndex < NotificationsListNode_Empty.Count);
  LNotification := NotificationsListNode_Empty[NotificationsNodesIndex];
  AssertTrue(ASender = LNotification.Sender);
  AssertEquals(ANode.Key, LNotification.Key);
  if not LNotification.IgnoreNodePtr then
    AssertSame(ANode, LNotification.Node);
  AssertTrue(AAction = LNotification.Action);
  AssertEquals(ADispose, LNotification.Dispose);
  AssertFalse(LNotification.Executed);
  LNotification.Executed := True;
  NotificationsListNode_Empty[NotificationsNodesIndex] := LNotification;
  Inc(NotificationsNodesIndex)
end;

procedure TTestCollections.NotifyTestStr(ASender: TObject; constref AItem: string; AAction: TCollectionNotification);
var
  LNotification: TNotificationRec_String;
begin
  AssertTrue(NotificationsIndex < NotificationsListStr.Count);
  LNotification := NotificationsListStr[NotificationsIndex];
  AssertTrue(ASender = LNotification.Sender);
  AssertEquals(AItem, LNotification.Item);
  AssertTrue(AAction = LNotification.Action);
  AssertFalse(LNotification.Executed);
  LNotification.Executed := True;
  NotificationsListStr[NotificationsIndex] := LNotification;
  Inc(NotificationsIndex)
end;

procedure TTestCollections.NotifyTestObj(ASender: TObject; constref AItem: TObject; AAction: TCollectionNotification);
var
  LNotification: TNotificationRec_TObject;
begin
  AssertTrue(NotificationsIndex < NotificationsListObj.Count);
  LNotification := NotificationsListObj[NotificationsIndex];
  AssertTrue(ASender = LNotification.Sender);
  AssertTrue(AItem = LNotification.Item);
  AssertTrue(AAction = LNotification.Action);
  AssertFalse(LNotification.Executed);
  LNotification.Executed := True;
  NotificationsListObj[NotificationsIndex] := LNotification;
  Inc(NotificationsIndex)
end;

procedure TTestCollections.CreateObjects(var AArray: TArray<TObject>; ACount: Integer);
var
  i: Integer;
begin
  SetLength(AArray, ACount);
  for i := 0 to ACount - 1 do
    AArray[i] := TObject.Create;
end;

procedure TTestCollections.FreeObjects(AArray: TArray<TObject>);
var
  o: TObject;
begin
  for o in AArray do
    o.Free;
end;

constructor TTestCollections.Create;
begin
  inherited;
  NotificationsListStr := TList<TNotificationRec_String>.Create;
  NotificationsListObj := TList<TNotificationRec_TObject>.Create;
  NotificationsListNode_String := TList<TNotificationNodeRec_String>.Create;
  NotificationsListNode_Empty := TList<TNotificationNodeRec_Empty>.Create;
end;

destructor TTestCollections.Destroy;
begin
  NotificationsListNode_Empty.Free;
  NotificationsListNode_String.Free;
  NotificationsListObj.Free;
  NotificationsListStr.Free;
  inherited;
end;

{ TStringsEnumerable }

function TStringsEnumerable.GetEnumerator: IEnumerator<string>;
begin
  Result := TStringsEnumerator.Create(FEnumerable.GetEnumerator, FEnumerable);
end;

constructor TStringsEnumerable.Create(const AItems: array of string);
begin
  FEnumerable := TStringList.Create;
  FEnumerable.AddRange(AItems);
end;

{ TStringsEnumerator }

function TStringsEnumerator.GetCurrent: string;
begin
  Result := FEnumerator.Current;
end;

function TStringsEnumerator.MoveNext: Boolean;
begin
  Result := FEnumerator.MoveNext;
end;

procedure TStringsEnumerator.Reset;
begin
  FEnumerator.Free;
  FEnumerator := FCollection.GetEnumerator;
end;

constructor TStringsEnumerator.Create(AEnumerator: TStringList.TEnumerator; ACollection: TStringList);
begin
  FEnumerator := AEnumerator;
  FCollection := ACollection;
end;

destructor TStringsEnumerator.Destroy;
begin
  FEnumerator.Free;
  inherited Destroy;
end;

{ TObjectEnumerable }

function TObjectEnumerable.GetEnumerator: IEnumerator<TObject>;
begin
  Result := TObjectEnumerator.Create(FEnumerable.GetEnumerator, FEnumerable);
end;

constructor TObjectEnumerable.Create(const AItems: array of TObject);
begin
  FEnumerable := TObjectList.Create;
  FEnumerable.AddRange(AItems);
end;

{ TObjectEnumerator }

function TObjectEnumerator.GetCurrent: TObject;
begin
  Result := FEnumerator.Current;
end;

function TObjectEnumerator.MoveNext: Boolean;
begin
  Result := FEnumerator.MoveNext;
end;

procedure TObjectEnumerator.Reset;
begin
  FEnumerator.Free;
  FEnumerator := FCollection.GetEnumerator;
end;

constructor TObjectEnumerator.Create(AEnumerator: TObjectList.TEnumerator; ACollection: TObjectList);
begin
  FEnumerator := AEnumerator;
  FCollection := ACollection;
end;

destructor TObjectEnumerator.Destroy;
begin
  FEnumerator.Free;
  inherited Destroy;
end;

end.