Singleton

[Selestis]

Здравствуйте!

Решил сделать у себя в программе подобие класса-одиночки. Почитал википедию, посмотрел как люди делают и сделал свою реализацию.
Собственно, вот она:

TSingleton = class
public
    class function NewInstance: TObject; override;
    procedure FreeInstance; override;
end;   
...

var SingletonArray: TObjectArray;       


class function TSingleton.NewInstance: TObject;
var i: integer;
begin
   Result:=nil;
   for i:=0 to SingletonArray.Count - 1 do
      if self = SingletonArray[i].ClassType then begin
         Result:=SingletonArray[i];
         break;
      end;
   if Result=nil then begin
      Result:=inherited NewInstance;
      SingletonArray.Add(Result);
   end;
end;

procedure TSingleton.FreeInstance;
var i: integer;
begin
   for i:=0 to SingletonArray.Count - 1 do
      if self = SingletonArray[i] then begin
         SingletonArray.Delete(i);
         break;
      end;
   inherited FreeInstance;
end;

Теоретически(да и практически) это позволяет получать ссылку на уже созданный или только что создаваемый синглетон через стандартный конструктор. В массиве хранятся все экземпляры(для наследников).
Однако все примеры, которые я видел, много общего с этим(кроме наличия массива, да и то не всегда) не имели... Хотя в большинстве из них не поддерживается наследование от данного класса. Тут вроде бы можно. Всё время видел несколько своих методов, а эти стандартные не применяются. Невольно в затылке вопрос, как говорится "что я делаю не так?".

Смущает фраза из википедии, которую я так и не особо понял:

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

Что это значит? Что подразумевается под модификацией кода...?
В общем, можно ли считать написанное реализацией класса-одиночки и нет ли ошибок?

Спасибо.

[maxionans]

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

Ну это значит, что если ты хочешь создать класс-наследник от твоего одиночки, в котором как-то меняется внутренняя логика объекта (одиночки), то клиентский код не должен от этого пострадать, то есть весь код, который до этого работал с одиночкой, должен остаться прежним и при этом не потерять работоспособность. В твоём случае такой фокус не пройдёт, т.к. твоя реализация одиночки привязывает его к типу класса, а поэтому клиенты будут всё так же инстанцировать объект старого класса, а новый класс им будет недоступен.

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

[Selestis]

А, понятно тогда. Что-то я тупил)

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

Да вроде бы нет... Проверил на таком примере:

TSO1 = class(TSingleton)
public
   A: single;
end;
TSO2 = class(TSingleton)
public
   B: integer;
   s: string;
end;  
...
   SO1:=TSO1.Create;
   SO1.A:=4.25;
   writeln(SO1.A:0:2);
   TSO2.Create.B:=5;
   TSO2.Create.S:='abcf';
   writeln(TSO2.Create.B);
   writeln(TSO2.Create.s);

Все унаследованные поля присвоились и вывелись на экран. Там как раз когда создается объект проверяется тип объектов в массиве(фактический). А inherited NewInstance видимо создает объект используя размер наследника... Хотя тогда неясно почему...?

Твой одиночка будет уничтожен по первому же запросу

Хмм, не сильно понимаю почему так не должно быть, но переделаю.
Что-то вроде этого? :

TSingleton = class
private
    RefCount: integer;
public
    class function NewInstance: TObject; override;
    procedure FreeInstance; override;
end;  
...
class function TSingleton.NewInstance: TObject;
var i: integer;
begin
   Result:=nil;
   for i:=0 to SingletonArray.Count - 1 do
      if self = SingletonArray[i].ClassType then begin
         Result:=SingletonArray[i];
         break;
      end;
   if Result=nil then begin
      Result:=inherited NewInstance;
      SingletonArray.Add(Result);
   end;
   inc((Result as TSingleton).RefCount);
end;

procedure TSingleton.FreeInstance;
var i: integer;
begin
   for i:=0 to SingletonArray.Count - 1 do
      if self = SingletonArray[i] then begin
         dec((SingletonArray[i] as TSingleton).RefCount);
         if (SingletonArray[i] as TSingleton).RefCount = 0 then begin
            SingletonArray.Delete(i);
         end;
         break;
      end;
   inherited FreeInstance;
end;

[maxionans]

Да вроде бы нет... Проверил на таком примере:

Ты не понял, этот пример не отображает проблемы. Смотри, ты создал два класса-одиночки TSO1 и TSO2 и как-то с ними работаешь. А потом тебе вдруг стало нужно создать наследника от TSO2 (т.е. класс TSO3) и задействовать его вместо TSO2. При этом тебе потребуется изменить весь код, где создаётся TSO2 и заменить в нём имя инстанцируемого класса. В принципе, это можно обойти используя паттерн Строитель или Абстрактная Фабрика, но тогда теряется смысл использования одиночки.

Хмм, не сильно понимаю почему так не должно быть, но переделаю.

ну простой пример:

procedure Foo;
var 
  singleton : TSingleton;
begin
  singleton := TSingleton.Create;
  try
    singleton.DoWork;
  finally
    singleton.Free;
  end;
end;

procedure Bar;
var
  singleton : TSingleton;
begin
  singleton := TSingleton.Create;
  try
    singleton.DoStuff;
    Foo;
  finally
    singleton.Free;
  end;
end;

Как думаешь, что случится при выполнении функции Bar?

Что-то вроде этого?

Именно.

[Selestis]

Как думаешь, что случится при выполнении функции Bar?

Видимо я просто неправильно понял суть. В моем понимании удаление есть удаление) Но если так принято, то, как говорится, нет вопросов)

При этом тебе потребуется изменить весь код, где создаётся TSO2

Блин, я чего-то не догоняю... А как ещё-то можно? Ессно, если я описываю новый класс, то я обязан, желая с ним работать, создать его, а не какого-то предка. Можно на примере посмотреть, что Вы имеете в виду? Если не трудно.

[Selestis]

Актуально)