Singleton em Delphi

O Singleton é um padrão de projeto utilizado para garantir que apenas uma única instância de determinada classe esteja disponível em todo o projeto, ou seja, ele garante que o objeto será instanciado apenas uma vez e será acessivel de forma global.

Isso é muito útil, por exemplo, quando lidamos com factory, pois a factory não precisa ser instanciada a todo momento. Outros exemplos são Pool de Conexões, Registry, Logs, ou recursos que sejam caros de instanciar a cada uso.



Contudo, há sempre muita controvérsia em torno da utilização do pattern singleton, isto porque ele é frequentemente mau empregado na solução dos problemas, fazendo com que o mesmo se torne apenas uma "variável global" e isso pode indicar que você tem um design pobre.

Há pelo menos duas formas diferentes em delphi de implementar este padrão. Primeiro vou mostrar como implementar utilizando uma classe comum, que possui um método estático - GetInstance() - que retorna a instância da classe.

type
  TSingleton = class
  private
    FCanFree: Boolean;

    class procedure InternalFree;
  public
    procedure FacaAlgo;

    class function GetInstance: TSingleton;

    class function NewInstance: TObject; override;
    procedure FreeInstance; override;
  end;

implementation

//Variável para armazenar a instância do Singleton
var
  _Singleton: TSingleton = nil;

{ TSingleton }

//Lógica de negócio
procedure TSingleton.FacaAlgo;
begin
  if IsConsole then
    Writeln(ClassName, ' Fazendo algo')
  else
    ShowMessageFmt('%s Fazendo algo',[ClassName]);
end;

//Indica que o objeto pode ser destruído
class procedure TSingleton.InternalFree;
begin
  if Assigned(_Singleton) then
  begin
    _Singleton.FCanFree := True;
    _Singleton.Free;
  end;
end;

//Só libera a instância quando o método InternalFree é chamado
procedure TSingleton.FreeInstance;
begin
  if FCanFree then
  begin
    inherited;
  end;
end;

//Na verdade o create vai invocar o método NewInstance indiretamente
class function TSingleton.GetInstance: TSingleton;
begin
  Result := TSingleton.Create;
end;

//Instanciação Preguiçosa - Só instancia o objeto quando alguém precisar
class function TSingleton.NewInstance: TObject;
begin
   if (_Singleton = nil) then
     _Singleton := TSingleton(inherited NewInstance);

   Result := _Singleton;
end;

initialization

finalization
  TSingleton.InternalFree;

Essa abordagem é relativamente simples, mais traz consigo alguns problemas em relação a deixar o código claro. O singleton não respeita o "contrato" descrito por seu métodos, isto é, quando eu chamo o método create, ele não cria um novo objeto e quando eu invoco o método Free, ele não destroy o objeto. Isso pode causar uma certa confusão na utilização do mesmo.

Vamos dar uma olhada em um código de teste para garantir que a instância é única.

type
  TTestSingleton = class(TTestCase)
  private
  published
    procedure GetInstanceDeveRetornarUmaInstancia;
    procedure GetInstanceECreateDeveRetornarAMesmaInstancia;
    procedure FreeNaoPodeDestruirInstancia;
    procedure DestroyNaoPodeDestruirInstancia;
    procedure FreeInstanceNaoPodeDestruirInstancia;
  end;
  
{ TTestSingleton }
  
procedure TTestSingleton.DestroyNaoPodeDestruirInstancia;
var
  vInstance,
  vInstanceAfterFree: TSingleton;
begin
  vInstance := TSingleton.GetInstance;
  vInstance.Destroy; //Não tem efeito
  vInstanceAfterFree := TSingleton.GetInstance;

  CheckTrue(vInstance = vInstanceAfterFree);
end;

procedure TTestSingleton.FreeInstanceNaoPodeDestruirInstancia;
var
  vInstance,
  vInstanceAfterFree: TSingleton;
begin
  vInstance := TSingleton.GetInstance;
  vInstance.FreeInstance; //Não tem efeito
  vInstanceAfterFree := TSingleton.GetInstance;

  CheckTrue(vInstance = vInstanceAfterFree);
end;

procedure TTestSingleton.FreeNaoPodeDestruirInstancia;
var
  vInstance,
  vInstanceAfterFree: TSingleton;
begin
  vInstance := TSingleton.GetInstance;
  vInstance.Free; //Não tem efeito
  vInstanceAfterFree := TSingleton.GetInstance;

  CheckTrue(vInstance = vInstanceAfterFree);
end;

procedure TTestSingleton.GetInstanceDeveRetornarUmaInstancia;
var
  vInstance: TSingleton;
begin
  vInstance := TSingleton.GetInstance;
  CheckNotNull(vInstance, 'Retornou nil');
  CheckTrue(vInstance is TSingleton, 'Não é um TSingleton');
  vInstance.FacaAlgo;
end;

procedure TTestSingleton.GetInstanceECreateDeveRetornarAMesmaInstancia;
var
  vFromGetInstance,
  vFromCreate: TObject;
begin
  vFromGetInstance := TSingleton.GetInstance;
  vFromCreate := TSingleton.Create; //Retorna a mesma instancia

  CheckTrue(vFromGetInstance = vFromCreate);

  vFromCreate := TSingleton.NewInstance; //Retorna a mesma instancia
  CheckTrue(vFromGetInstance = vFromCreate);
end;  

No próximo post vou mostrar o segundo tipo de implementação, utilizando interfaces.

Por hoje era isso, até a próxima e usem o Singleton com moderação.