utils/uutlArrayContainer.pas

unit uutlArrayContainer;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  uutlCommon;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlArrayContainer<T> = class(TutlInterfaceNoRefCount)
  protected type
    PT = ^T;

  strict private
    fList: PT;
    fCapacity: Integer;
    fOwnsItems: Boolean;
    fCanShrink: Boolean;
    fCanExpand: Boolean;

    function  GetIsEmpty: Boolean; inline;

  protected
    function  GetCount:       Integer; virtual; abstract;
    procedure SetCount        (const aValue: Integer); virtual; abstract;
    function  GetInternalItem (const aIndex: Integer): PT;
    procedure SetCapacity     (const aValue: integer); virtual;

    procedure Release         (var aItem: T; const aFreeItem: Boolean); virtual;

    procedure Shrink          (const aExactFit: Boolean);
    procedure Expand;

  protected
    property Count:     Integer read GetCount write SetCount;
    property IsEmpty:   Boolean read GetIsEmpty;
    property Capacity:  Integer read fCapacity  write SetCapacity;
    property CanShrink: Boolean read fCanShrink write fCanShrink;
    property CanExpand: Boolean read fCanExpand write fCanExpand;
    property OwnsItems: Boolean read fOwnsItems write fOwnsItems;

  public
    constructor Create(const aOwnsItems: Boolean);
    destructor  Destroy; override;
  end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlArrayContainer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlArrayContainer.GetIsEmpty: Boolean;
begin
  result := (Count = 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlArrayContainer.GetInternalItem(const aIndex: Integer): PT;
begin
  if (aIndex < 0) or (aIndex >= fCapacity) then
    raise EOutOfRangeException.Create('capacity out of range', aIndex, 0, fCapacity-1);
  result := fList + aIndex;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlArrayContainer.SetCapacity(const aValue: integer);
begin
  if (fCapacity = aValue) then
    exit;
  if (aValue < Count) then
    raise EArgumentException.Create('can not reduce capacity below count');
  ReAllocMem(fList, aValue * SizeOf(T));
  FillByte((fList + fCapacity)^, (aValue - fCapacity) * SizeOf(T), 0);
  fCapacity := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlArrayContainer.Release(var aItem: T; const aFreeItem: Boolean);
begin
  if not utlFinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem) then
    Finalize(aItem);
  FillByte(aItem, SizeOf(aItem), 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlArrayContainer.Shrink(const aExactFit: Boolean);
begin
  if not fCanShrink then
    raise EInvalidOperation.Create('shrinking is not allowed');
  if (aExactFit) then
    SetCapacity(Count)
  else if (fCapacity > 128) and (Count < fCapacity shr 2) then // less than 25% used
    SetCapacity(fCapacity shr 1); // shrink to 50%
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlArrayContainer.Expand;
begin
  if (Count < fCapacity) then
    exit;
  if not fCanExpand then
    raise EInvalidOperation.Create('expanding is not allowed');
  if (fCapacity <= 0) then
    SetCapacity(4)
  else if (fCapacity < 128) then
    SetCapacity(fCapacity shl 1)  // + 100%
  else
    SetCapacity(fCapacity + fCapacity shr 2); // +  25%
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlArrayContainer.Create(const aOwnsItems: Boolean);
begin
  inherited Create;
  fOwnsItems  := aOwnsItems;
  fList       := nil;
  fCapacity   := 0;
  fCanExpand  := true;
  fCanShrink  := true;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlArrayContainer.Destroy;
begin
  if Assigned(fList) then begin
    FreeMem(fList);
    fList := nil;
  end;
  inherited Destroy;
end;

end.