Шаблон Delphi Singleton

Ответ 1

Я думаю, что если бы я хотел объектную вещь, у которой не было никаких средств для построения, я бы, вероятно, использовал интерфейс с объектом реализации, содержащимся в разделе реализации единицы.

Я бы разоблачил интерфейс глобальной функцией (объявленной в разделе интерфейса). Экземпляр будет убран в разделе завершения.

Для обеспечения безопасности потоков я бы использовал либо критический раздел (или эквивалент), либо, возможно, тщательно реализовал блокировку с двойным проверкой, но признал, что наивные реализации работают только из-за сильной природы модели памяти x86.

Он будет выглядеть примерно так:

unit uSingleton;

interface

uses
  SyncObjs;

type
  ISingleton = interface
    procedure DoStuff;
  end;

function Singleton: ISingleton;

implementation

type
  TSingleton = class(TInterfacedObject, ISingleton)
  private
    procedure DoStuff;
  end;

{ TSingleton }

procedure TSingleton.DoStuff;
begin
end;

var
  Lock: TCriticalSection;
  _Singleton: ISingleton;

function Singleton: ISingleton;
begin
  Lock.Acquire;
  Try
    if not Assigned(_Singleton) then
      _Singleton := TSingleton.Create;
    Result := _Singleton;
  Finally
    Lock.Release;
  End;
end;

initialization
  Lock := TCriticalSection.Create;

finalization
  Lock.Free;

end.

Ответ 2

Было упомянуто, что я должен опубликовать свой ответ с здесь.

Существует метод, называемый "Без блокировки" , который делает то, что вы хотите:

interface

function getInstance: TObject;

implementation

var
   AObject: TObject;

function getInstance: TObject;
var
   newObject: TObject;
begin
   if (AObject = nil) then
   begin
      //The object doesn't exist yet. Create one.
      newObject := TObject.Create;

      //It possible another thread also created one.
      //Only one of us will be able to set the AObject singleton variable
      if InterlockedCompareExchangePointer(AObject, newObject, nil) <> nil then
      begin
         //The other beat us. Destroy our newly created object and use theirs.
         newObject.Free;
      end;
   end;

   Result := AObject;
end;

Использование InterlockedCompareExchangePointer создает барьер полной памяти вокруг операции. Возможно, вам удастся уйти с помощью InterlockedCompareExchangePointerAcquire или InterlockedCompareExchangeRelease, чтобы уйти с оптимизацией, только имея забор памяти до или после. Проблема с этим:

• Я недостаточно умен, чтобы узнать, будет ли работать Приобретать или Release.
• Вы строите объект, поражение производительности памяти - наименьшее из ваших забот (это безопасность потока).

InterlockedCompareExchangePointer

Windows не добавляла InterlockedCompareExchangePointer до примерно 2003 года. На самом деле это просто обертка вокруг InterlockedCompareExchange

function InterlockedCompareExchangePointer(var Destination: Pointer; Exchange: Pointer; Comparand: Pointer): Pointer stdcall;
const
    SPointerAlignmentError = 'Parameter to InterlockedCompareExchangePointer is not 32-bit aligned';
begin
{IFDEF Debug}
    //On 64-bit systems, the pointer must be aligned to 64-bit boundaries.
    //On 32-bit systems, the pointer must be aligned to 32-bit boundaries.
    if ((NativeInt(Destination) mod 4) <> 0)
            or ((NativeInt(Exchange) mod 4) <> 0)
            or ((NativeInt(Comparand) mod 4) <> 0) then
    begin
        OutputDebugString(SPointerAlignmentError);
        if IsDebuggerPresent then
            Windows.DebugBreak;
    end;
{ENDIF}
    Result := Pointer(IntPtr(InterlockedCompareExchange(Integer(IntPtr(Destination)), IntPtr(Exchange), IntPtr(Comparand))));
end;

В XE6 я обнаружил InterlockedCompareExchangePointer, реализованный для 32-разрядной версии Windows.Winapi, реализованный таким же образом (за исключением проверки безопасности):

{$IFDEF WIN32}
function InterlockedCompareExchangePointer(var Destination: Pointer; Exchange: Pointer; Comparand: Pointer): Pointer; inline;
begin
  Result := Pointer(IntPtr(InterlockedCompareExchange(Integer(IntPtr(Destination)), IntPtr(Exchange), IntPtr(Comparand))));
end;
{$ENDIF}

В новых версиях Delphi вы бы идеально использовали вспомогательный класс TInterlocked от System.SyncObjs:

if TInterlocked.CompareExchange({var}AObject, newObject, nil) <> nil then
begin
   //The other beat us. Destroy our newly created object and use theirs.
   newObject.Free;
end;

Примечание. Любой код, выпущенный в общественное достояние. Не требуется атрибуция.

Ответ 3

Проблема с Delphi заключается в том, что вы всегда наследуете конструктор Create от TObject. Но мы можем справиться с этим довольно красиво! Вот путь:

TTrueSingleton = class
private
  class var FSingle: TTrueSingleton;
  constructor MakeSingleton;
public
  constructor Create;reintroduce;deprecated 'Don''t use this!';

  class function Single: TTrueSingleton;
end;

Как вы можете видеть, у нас может быть частный конструктор, и мы можем скрыть унаследованный конструктор TObject.Create! В реализации TTrueSingleton.Create вы можете поднять ошибку (блок времени выполнения), а ключевое слово deprecated имеет дополнительное преимущество для обеспечения обработки ошибок во время компиляции!

Здесь часть реализации:

constructor TTrueSingleton.Create;
begin
  raise Exception.Create('Don''t call me directly!');
end;

constructor TTrueSingleton.MakeSingleton;
begin
end;

class function TTrueSingleton.Single: TTrueSingleton;
begin
  if not Assigned(FSingle) then FSingle := TTrueSingleton.MakeSingleton;
  Result := FSingle;
end;

Если во время компиляции вы заметили, что вы это делаете:

var X: TTrueSingleton := TTrueSingleton.Create;

он предоставит вам предупреждение deprecated с предоставленным сообщением об ошибке. Если вы достаточно упрямы, чтобы игнорировать его, во время выполнения вы не получите объект, а исключительное исключение.

В дальнейшем отредактируйте, чтобы обеспечить безопасность потоков. Прежде всего, я должен признаться, что для моего собственного кода я не забочусь о такой безопасности потоков. Вероятность для двух потоков, обращающихся к моей программе создания однопользовательского режима в течение такого короткого временного интервала, который вызывает создание двух объектов TTrueSingleton, настолько мала, что это просто не стоит нескольких строк кода.

Но этот ответ не был бы полным без безопасности потока, так что здесь я беру на себя эту проблему. Я буду использовать простую прямую блокировку (ожидание), потому что она эффективна, когда не требуется блокировки; Кроме того, он блокирует только

Для этого нужно добавить другой класс var: class var FLock: Integer. Функция класса Singleton должна выглядеть так:

class function TTrueSingleton.Single: TTrueSingleton;
var Tmp: TTrueSingleton;
begin
  MemoryBarrier; // Make sure all CPU caches are in sync
  if not Assigned(FSingle) then
  begin
    Assert(NativeUInt(@FLock) mod 4 = 0, 'FLock needs to be alligned to 32 bits.');

    // Busy-wait lock: Not a big problem for a singleton implementation
    repeat
    until InterlockedCompareExchange(FLock, 1, 0) = 0; // if FLock=0 then FLock:=1;
    try
      if not Assigned(FSingle) then
      begin 
        Tmp := TTrueSingleton.MakeSingleton;
        MemoryBarrier; // Second barrier, make sure all CPU caches are in sync.
        FSingle := Tmp; // Make sure the object is fully created when we assign it to FSingle.
      end;
    finally FLock := 0; // Release lock
    end;
  end;
  Result := FSingle;
end;

Ответ 4

Самый эффективный способ убедиться, что что-то не может быть создано, - это сделать чистый абстрактный класс. То есть, если вам будет достаточно внимания, чтобы прислушаться к подсказкам и предупреждениям компилятора.

Затем определите функцию в разделе реализации, которая возвращает ссылку на этот абстрактный класс. Как Космин делает в одном из своих ответов.

Раздел реализации реализует эту функцию (вы можете даже использовать ленивую копию здесь, поскольку Cosmin также показывает /ed ).

Но суть состоит в том, чтобы объявить и реализовать конкретный класс в разделе реализации устройства, поэтому только экземпляр может создать его.

interface

type
  TSingleton = class(TObject)
  public
    procedure SomeMethod; virtual; abstract;
  end;

  function Singleton: TSingleton;

implementation

var
  _InstanceLock: TCriticalSection;
  _SingletonInstance: TSingleTon;

type
  TConcreteSingleton = class(TSingleton)
  public
    procedure SomeMethod; override;
  end;

function Singleton: TSingleton;
begin
  _InstanceLock.Enter;
  try
    if not Assigned(_SingletonInstance) then
      _SingletonInstance := TConcreteSingleton.Create;

    Result := _SingletonInstance;
  finally
    _InstanceLock.Leave;
  end;
end;

procedure TConcreteSingleton.SomeMethod;
begin
  // FLock can be any synchronisation primitive you like and should of course be
  // instantiated in TConcreteSingleton constructor and freed in its destructor.
  FLock.Enter;  
  try
  finally
    FLock.Leave;
  end;
end;

Тем не менее, помните, что существует множество проблем с использованием синглетонов: http://jalf.dk/blog/2010/03/singletons-solving-problems-you-didnt-know-you-never-had-since-1995/

Безопасность потока

Дэвид абсолютно прав в своем комментарии, что я ошибался раньше, чем функция, не нуждающаяся в защите. Создание экземпляра действительно нуждается в защите, или вы можете получить два (возможно, более) экземпляра singleton и несколько из них в неопределенном состоянии в отношении освобождения (что было бы сделано в разделе финализации, как и во многих ленивых механизмах создания экземпляров). Итак, это измененная версия.

Чтобы обеспечить безопасность потоков в этой настройке, вам необходимо защитить экземпляр singleton, и вам необходимо защитить все методы в конкретном классе, которые общедоступны через своего абстрактного предка. Другие методы не нуждаются в защите, поскольку они могут быть вызваны только через общедоступные, поэтому защищены этими методами.

Вы можете защитить это простым критическим разделом, объявленным в реализации, созданным в инициализации и бесплатным в разделе завершения. Конечно, CS должен был бы также защитить освобождение синглтона, и поэтому он должен быть впоследствии освобожден.

Обсуждая это с коллегой, мы придумали способ (mis)/(ab) использовать сам указатель экземпляра как своего рода механизм блокировки. Это сработает, но я нахожу это уродливым, чтобы поделиться с миром в этот момент времени...

Какие примитивы синхронизации используются для защиты общепринятых методов, полностью зависит от "пользователя" (кодера) и могут быть адаптированы к цели синглтона.

Ответ 5

Существует способ скрыть унаследованный конструктор "Создать" TObject. Хотя невозможно изменить уровень доступа, он может быть скрыт с помощью другого общедоступного метода без параметров с тем же именем: "Создать". Это значительно упрощает реализацию класса Singleton. Смотрите простоту кода:

unit Singleton;

interface

type
  TSingleton = class
  private
    class var _instance: TSingleton;
  public
    //Global point of access to the unique instance
    class function Create: TSingleton;

    destructor Destroy; override;
  end;

implementation

{ TSingleton }

class function TSingleton.Create: TSingleton;
begin
  if (_instance = nil) then
    _instance:= inherited Create as Self;

  result:= _instance;
end;

destructor TSingleton.Destroy;
begin
  _instance:= nil;
  inherited;
end;

end.

Я добавил детали к своему первоначальному сообщению: http://www.yanniel.info/2010/10/singleton-pattern-delphi.html

Ответ 6

Для обеспечения безопасности потоков вы должны использовать блокировку вокруг создания в "TTestClass.GetInstance".

procedure CreateSingleInstance(aDestination: PPointer; aClass: TClass);
begin
  System.TMonitor.Enter(Forms.Application);
  try
    if aDestination^ = nil then  //not created in the meantime?
      aDestination^ := aClass.Create;
  finally
    System.TMonitor.Exit(Forms.Application);
  end;
end;

THREADSAFE:

if not Assigned(FInstance) then
  CreateSingleInstance(@FInstance, TTestClass);      

И вы можете создать исключение на случай, если кто-то попытается создать его через обычный .Create(сделать частный конструктор CreateSingleton)