Delphi. GarbageCollector

Понравилось, на одном из форумов, а ля сборщик мусора, теоретически должно сократиться количество кода… Но надо потестить….

unit uGC;
 
interface
 
uses
  System.Generics.Collections, Rtti, System.Classes;
 
 ///<summary> Класс позволяющий упростить освобождение памяти.</summary>
type
  TGarbageCollector = class(TComponent)
  public
    const
      DEFAULT_TAG = 'DEFAULT_TAG';
  private
    items: TDictionary<TObject, string>;
  public
    //constructor Create();
    destructor Destroy; override;
//    constructor Create(AOwner: TComponent); override;
    constructor Create(AOwner: TComponent); override;
  ///<summary> Добавить элемент в список и вернуть свежедобавленный элемент.</summary>
    function Add<T>(item: T): T; overload;
  ///<summary> Добавить помеченый элемент в список и вернуть свежедобавленный элемент.</summary>
    function Add<T>(item: T; const tag: string): T; overload;
  /// <summary> Произвести сборку мусора с указанной меткой. </summary>
    procedure Collect(const tag: string);
  end;
 
var
  GC: TGarbageCollector;
 
implementation
 
uses
  System.Types, System.SysUtils;
 
{
constructor TGarbageCollector.Create();
begin
  items := TObjectDictionary<TObject, string>.Create([doOwnsKeys]);
end;
}
 
constructor TGarbageCollector.Create(AOwner: TComponent);
begin
  inherited;
  items := TObjectDictionary<TObject, string>.Create([doOwnsKeys]);
end;
 
destructor TGarbageCollector.Destroy;
begin
  items.free();
  inherited Destroy;
end;
 
function TGarbageCollector.Add<T>(item: T): T;
begin
  result := Add(item, DEFAULT_TAG);
end;
 
function TGarbageCollector.Add<T>(item: T; const tag: string): T;
var
  obj: TObject;
  v: TValue;
begin
  v := TValue.From<T>(item);
  if v.IsObject then
  begin
    items.add(v.AsObject, tag);
    result := item;
  end
  else
    raise Exception.Create('not an Object');
end;
 
procedure TGarbageCollector.Collect(const tag: string);
var
  key: TObject;
  item: TPair<TObject, string>;
  gcList: TList<TObject>;
begin
  gcList := TList<TObject>.Create();
  try
    for item in items do
    begin
      if (item.Value = tag) then
        gcList.add(item.Key);
    end;
 
    for key in gcList do
      items.remove(key);
  finally
    gcList.free();
  end;
end;
 
end.

unit uGC;

interface

uses

System.Generics.Collections, Rtti, System.Classes;

///<summary> Класс позволяющий упростить освобождение памяти.</summary>

type

TGarbageCollector = class(TComponent)

public

const

DEFAULT_TAG = 'DEFAULT_TAG';

private

items: TDictionary<TObject, string>;

public

//constructor Create();

destructor Destroy; override;

// constructor Create(AOwner: TComponent); override;

constructor Create(AOwner: TComponent); override;

///<summary> Добавить элемент в список и вернуть свежедобавленный элемент.</summary>

function Add<T>(item: T): T; overload;

///<summary> Добавить помеченый элемент в список и вернуть свежедобавленный элемент.</summary>

function Add<T>(item: T; const tag: string): T; overload;

/// <summary> Произвести сборку мусора с указанной меткой. </summary>

procedure Collect(const tag: string);

end;

var

GC: TGarbageCollector;

implementation

uses

System.Types, System.SysUtils;

{

constructor TGarbageCollector.Create();

begin

items := TObjectDictionary<TObject, string>.Create([doOwnsKeys]);

end;

}

constructor TGarbageCollector.Create(AOwner: TComponent);

begin

inherited;

items := TObjectDictionary<TObject, string>.Create([doOwnsKeys]);

end;

destructor TGarbageCollector.Destroy;

begin

items.free();

inherited Destroy;

end;

function TGarbageCollector.Add<T>(item: T): T;

begin

result := Add(item, DEFAULT_TAG);

end;

function TGarbageCollector.Add<T>(item: T; const tag: string): T;

var

obj: TObject;

v: TValue;

begin

v := TValue.From<T>(item);

if v.IsObject then

begin

items.add(v.AsObject, tag);

result := item;

end

else

raise Exception.Create('not an Object');

end;

procedure TGarbageCollector.Collect(const tag: string);

var

key: TObject;

item: TPair<TObject, string>;

gcList: TList<TObject>;

begin

gcList := TList<TObject>.Create();

try

for item in items do

begin

if (item.Value = tag) then

gcList.add(item.Key);

end;

for key in gcList do

items.remove(key);

finally

gcList.free();

end;

end.

Пример использования

program GarbageCollector;
 
uses
  Vcl.Forms,
  uMain in 'uMain.pas' {Main},
  uGC in 'uGC.pas',
  uSomeClass in 'uSomeClass.pas';
 
{$R *.res}
 
begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  GC := TGarbageCollector.Create(Application); // <<<
  Application.CreateForm(TMain, Main);
  Application.Run;
end.

program GarbageCollector;

uses

Vcl.Forms,

uMain in 'uMain.pas' {Main},

uGC in 'uGC.pas',

uSomeClass in 'uSomeClass.pas';

{$R *.res}

begin

Application.Initialize;

Application.MainFormOnTaskbar := True;

GC := TGarbageCollector.Create(Application); // <<<

Application.CreateForm(TMain, Main);

Application.Run;

end.

В любом месте проекта делаем что-то подобное…

someInstance := GC.Add(TSomeClass.Create(nil), 'TSomeClassTag');
  // do smth with someInstance
  //now destroy
  GC.Collect('TSomeClassTag');
  //
  anotherInstance := GC.Add(TSomeClass.Create(nil), 'TSomeClassTag');
  // do smth with anotherInstance
  // not destroying here - will be destroyed on app destroy...

someInstance := GC.Add(TSomeClass.Create(nil), 'TSomeClassTag');

// do smth with someInstance

//now destroy

GC.Collect('TSomeClassTag');

anotherInstance := GC.Add(TSomeClass.Create(nil), 'TSomeClassTag');

// do smth with anotherInstance

// not destroying here - will be destroyed on app destroy...

Врубил

ReportMemoryLeaksOnShutdown := true;

1	ReportMemoryLeaksOnShutdown := true;

При закрытии приложения – тишина, и это радует. Прошелся отладчиком, посмотрел, что да, заходим в Collect и все уничтожается как надо…

Ну, и если у нас несколько потоков обращаются к одному и тому же объекту, можно добавить критические секции… Но это, просто мысль вслух…

MY PROJECTS

Recent Posts

Categories