Begrenzter String, TList und InterfaceObject > Datenmüll

[Sir Rufo]

Es gibt aber Abhilfe

Delphi-Quellcode:

program dp_186522;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.Generics.Collections,
  System.SysUtils;

type
  TMyID = string[ 10 ];

  IMyObject<T> = interface
    [ '{22041332-1221-4EBD-BBC5-1AF3C914E08B}' ]
    procedure AddValue( const Value: T );
    function GetValue( const Index: Integer ): T;
  end;

  TMyObject<T> = class( TInterfacedObject, IMyObject<T> )
  strict private
    internalList: TList<T>;
  public
    constructor Create;
    destructor Destroy; override;

    procedure AddValue( const Value: T );
    function GetValue( const Index: Integer ): T;
  end;

  TWrap<T> = record
  private
    FValue: T;
  public
    class operator implicit( const a: T ): TWrap<T>;
    class operator implicit( const a: TWrap<T> ): T;
  end;

  TMyWrappedObject<T> = class( TInterfacedObject, IMyObject<T> )
  strict private
    internalList: TList<TWrap<T>>;
  public
    constructor Create;
    destructor Destroy; override;

    procedure AddValue( const Value: T );
    function GetValue( const Index: Integer ): T;
  end;

  { TMyObject<T> }

procedure TMyObject<T>.AddValue( const Value: T );
begin
  internalList.Add( Value );
end;

constructor TMyObject<T>.Create;
begin
  inherited;
  internalList := TList<T>.Create;
end;

destructor TMyObject<T>.Destroy;
begin
  internalList.Free;
  inherited;
end;

function TMyObject<T>.GetValue( const Index: Integer ): T;
begin
  Result := internalList[ index ];
end;

{ TWrap<T> }

class operator TWrap<T>.implicit( const a: T ): TWrap<T>;
begin
  Result.FValue := a;
end;

class operator TWrap<T>.implicit( const a: TWrap<T> ): T;
begin
  Result := a.FValue;
end;

{ TMyWrappedObject<T> }

procedure TMyWrappedObject<T>.AddValue( const Value: T );
begin
  internalList.Add( Value );
end;

constructor TMyWrappedObject<T>.Create;
begin
  inherited;
  internalList := TList < TWrap < T >>.Create;
end;

destructor TMyWrappedObject<T>.Destroy;
begin
  internalList.Free;
  inherited;
end;

function TMyWrappedObject<T>.GetValue( const Index: Integer ): T;
begin
  Result := internalList[ index ];
end;

procedure Test1;
var
  ID1, ID2: TMyID;
  Liste   : TList<TMyID>;
begin
  ID1   := ( 'ABCDEFGHIJ' );
  Liste := ( TList<TMyID>.Create );
  Liste.Add( ID1 );
  ID2 := ( Liste[ 0 ] );
  Assert( ID1 = ID2 );
end;

procedure Test2;
var
  ID1, ID2: TMyID;
  MyObj1  : IMyObject<TMyID>;
begin
  ID1    := ( 'ABCDEFGHIJ' );
  MyObj1 := ( TMyObject<TMyID>.Create );
  MyObj1.AddValue( ID1 );
  ID2 := ( MyObj1.GetValue( 0 ) );
  Assert( ID1 = ID2 );
end;

procedure Test3;
var
  ID1, ID2: TMyID;
  MyObj1  : IMyObject<TMyID>;
begin
  ID1    := ( 'ABCDEFGHIJ' );
  MyObj1 := ( TMyWrappedObject<TMyID>.Create );
  MyObj1.AddValue( ID1 );
  ID2 := ( MyObj1.GetValue( 0 ) );
  Assert( ID1 = ID2 );
end;

begin
  try
    Test1;
    Test2; // fails
    Test3; // pass
  except
    on E: Exception do
      Writeln( E.ClassName, ': ', E.Message );
  end;
  Readln;

end.