mORMot Open Source

George

Member

Registered: 2016-04-05

Posts: 140

TRawUTF8ListHashed and generics

Hello.

I found very handy to use TRawUTF8ListHashed with generic syntax.
AFAIK some classes in mORMot already support generic syntax.
So, i've implemented new class based on TRawUTF8ListHashed.

This is not great code and not universal.
Does anyone have better TRawUTF8ListHashed extension that support generic syntax?

unit SynCommons.Generics;

interface

uses
  System.Rtti,
  SynCommons;

type

  TRawUTF8ListHashed<T> = class(TRawUTF8ListHashed)
  public
    // TRawUTF8ListHashed
    function AddObjectIfNotExisting(const aText: RawUTF8; aObject: T; wasAdded: PBoolean = nil): PtrInt; reintroduce;

    // TRawUTF8List
  type
    GenericObjectArray = array of T;
    PGenericObjectPointerArray = ^GenericObjectArray;
  private
    procedure PutObject(Index: PtrInt; const Value: T);
    function GetObjectPtr: PGenericObjectPointerArray;
  public
    function GetObject(Index: PtrInt): T; {$IFDEF HASINLINE}inline; {$ENDIF}
    function GetObjectByName(const Name: RawUTF8): T;
    function AddObject(const aText: RawUTF8; aObject: T): PtrInt;
    function IndexOfObject(aObject: T): PtrInt;
    property Objects[Index: PtrInt]: T read GetObject write PutObject;
    property ObjectPtr: PGenericObjectPointerArray read GetObjectPtr;
  end;

implementation

{ TRawUTF8ListHashed<T> }

{$REGION 'TRawUTF8ListHashed'}

function TRawUTF8ListHashed<T>.AddObjectIfNotExisting(const aText: RawUTF8; aObject: T; wasAdded: PBoolean): PtrInt;
var
  Val: TValue;
begin
  Val := TValue.From<T>(aObject);
  // Class
  if Val.Kind = tkClass then
    Result := inherited AddObjectIfNotExisting(aText, Val.AsObject, wasAdded);
  // Interface
  if Val.Kind = tkInterface then
    Result := inherited AddObjectIfNotExisting(aText, Val.AsInterface as TObject, wasAdded);
end;

{$ENDREGION}
{$REGION 'TRawUTF8List'}

procedure TRawUTF8ListHashed<T>.PutObject(Index: PtrInt; const Value: T);
var
  Val: TValue;
begin
  Val := TValue.From<T>(Value);
  // Class
  if Val.Kind = tkClass then
    inherited PutObject(Index, Val.AsObject);
  // Interface
  if Val.Kind = tkInterface then
    inherited PutObject(Index, Val.AsInterface as TObject);
end;

function TRawUTF8ListHashed<T>.GetObject(Index: PtrInt): T;
var
  Value: TValue;
begin
  Value := TValue.From(inherited GetObject(Index));
  Result := Value.AsType<T>;
end;

function TRawUTF8ListHashed<T>.GetObjectByName(const Name: RawUTF8): T;
var
  Value: TValue;
begin
  Value := TValue.From(inherited GetObjectByName(Name));
  Result := value.AsType<T>;
end;

function TRawUTF8ListHashed<T>.AddObject(const aText: RawUTF8; aObject: T): PtrInt;
var
  Value: TValue;
begin
  Value := TValue.From<T>(aObject);
  // Class
  if Value.Kind = tkClass then
    Result := inherited AddObject(aText, Value.AsObject);
  // Interface
  if Value.Kind = tkInterface then
    Result := inherited AddObject(aText, Value.AsInterface as TObject);
end;

function TRawUTF8ListHashed<T>.IndexOfObject(aObject: T): PtrInt;
var
  Value: TValue;
begin
  Value := TValue.From<T>(aObject);
  // Class
  if Value.Kind = tkClass then
    Result := inherited IndexOfObject(Value.AsObject);
  // Interface
  if Value.Kind = tkInterface then
    Result := inherited IndexOfObject(Value.AsInterface as TObject);
end;

function TRawUTF8ListHashed<T>.GetObjectPtr: PGenericObjectPointerArray;
begin
  Result := PGenericObjectPointerArray(GetObjectPtr());
end;

{$ENDREGION}

end.

Last edited by George (2017-07-19 14:30:58)