Recent

Author Topic: Singleton pattern  (Read 12694 times)

Blaazen

  • Hero Member
  • *****
  • Posts: 2952
  • POKE 54296,15
    • Eye-Candy Controls
Singleton pattern
« on: February 01, 2013, 03:26:04 pm »
If someone need to apply Singleton design pattern.
Code: [Select]
unit Unit2;                                 
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

type   
  { TSingleton }

  TSingleton = class sealed
  protected
    class var RefCounter: Integer;
    class constructor CreateSingleton;
    class destructor DestroySingleton;
  public
    class var Singleton: TSingleton;
    class function NewInstance: TObject; override;
    procedure FreeInstance; override;
  end;
   
implementation

class constructor TSingleton.CreateSingleton;
begin
  RefCounter:=0;
  { comment following line will disable auto-create }
  Singleton:=TSingleton.Create;
end;

class destructor TSingleton.DestroySingleton;
begin
  { ucomment following line  if you don't want to Free Singleton instances manually }
  //while RefCounter>0 do
    Singleton.Free;
  { or remove this class-destructor at all if you don't use the auto-creation }
end;

procedure TSingleton.FreeInstance; 
begin
  dec(RefCounter);
  if RefCounter=0 then
    begin
      Singleton:=nil;
      inherited FreeInstance;
    end;
end;

class function TSingleton.NewInstance: TObject; 
begin
  if not assigned(Singleton) then
    begin
      Singleton:=TSingleton(inherited NewInstance);
      { initialize private variables here}
    end;
  Result:=Singleton;
  inc(RefCounter);
end;     

end.   
It is based on some delphi tutorial but I can' find the source. I'll add it (maybe).

The code is very simple. You can create it many times but it will point always to the same instance.
Currently, the instance is auto-created and auto-destroyed but you can change it by commenting the relevant lines.
Lazarus 2.1.0 r64044 FPC 3.3.1 r40507 x86_64-linux-qt Chakra, Qt 4.8.7/5.13.2, Plasma 5.17.3
Lazarus 1.8.2 r57369 FPC 3.0.4 i386-win32-win32/win64 Wine 3.21

Try Eye-Candy Controls: https://sourceforge.net/projects/eccontrols/files/

taazz

  • Hero Member
  • *****
  • Posts: 5365
Re: Singleton pattern
« Reply #1 on: February 01, 2013, 03:42:07 pm »
looks interesting I have a question though what is the use of the following methods

    class constructor CreateSingleton;
    class destructor DestroySingleton;

they are never called from your code but you claim that the code in them will be executed and autocreate a TSingleton as well which I do not understand. any documentation I could read to make things clearer?
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

circular

  • Hero Member
  • *****
  • Posts: 3505
    • Personal webpage
Re: Singleton pattern
« Reply #2 on: February 01, 2013, 03:52:19 pm »
To me, it seems a complicated way to to that.

Basically, you only need one class function to get the instance and one class variable to store that instance.

The name NewInstance is confusing, it would be better to call it QueryInstance and ReleaseInstance for decreasing the reference counter.

You may also not count at all, and just call a private destructor in "finalization" section of the unit.
Conscience is the debugger of the mind

taazz

  • Hero Member
  • *****
  • Posts: 5365
Re: Singleton pattern
« Reply #3 on: February 01, 2013, 04:02:41 pm »
NewInstance is an existing method part of the base Tobject class which is used internally by the creator to actually allocate and initialize the required memory of an object by overriding it and returning the existing object instead of a new one when the user calls TSingleton.Create. Can't be renamed. The same reasoning applies to the FreeInstance method but for the destruction process.
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

Leledumbo

  • Hero Member
  • *****
  • Posts: 8273
  • Programming + Glam Metal + Tae Kwon Do = Me
Re: Singleton pattern
« Reply #4 on: February 01, 2013, 04:06:21 pm »
Quote
they are never called from your code but you claim that the code in them will be executed and autocreate a TSingleton as well which I do not understand. any documentation I could read to make things clearer?
Find Delphi documentation/article regarding this (I believe it's not in FPC docs yet). Basically, a class constructor/destructor will be called automatically, just like initialization/finalization section of a unit.

circular

  • Hero Member
  • *****
  • Posts: 3505
    • Personal webpage
Re: Singleton pattern
« Reply #5 on: February 01, 2013, 04:07:28 pm »
@taazz: Ok, I think I get it.

In fact this code is a mix between using ref counter and no ref counter?
Conscience is the debugger of the mind

taazz

  • Hero Member
  • *****
  • Posts: 5365
Re: Singleton pattern
« Reply #6 on: February 01, 2013, 04:19:25 pm »
no refcounter is always used the code tries to distinguish between auto creating the 1st singleton object or not but I do not understand the class constructor/destructor mechanism to comment any farther on the implementation which from a first look it seems problematic that's why I asked for documentation.

Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

circular

  • Hero Member
  • *****
  • Posts: 3505
    • Personal webpage
Re: Singleton pattern
« Reply #7 on: February 01, 2013, 04:29:59 pm »
Hehe here is how I would do a singleton :
Code: [Select]
Unit Unit3;

type
  TSingletonObject = class
    ...
  end;

function SingletonObject: TSingletonObject;

implementation

var
  SingletonObjectInstance: TSingletonObject;

function SingletonObject: TSingletonObject;
begin
  if SingletonObjectInstance = nil then
    SingletonObjectInstance := TSingletonObject.Create;
  result := SingletonObjectInstance;
end;

finalization
  SingletonObjectInstance.Free;
end.
Conscience is the debugger of the mind

Blaazen

  • Hero Member
  • *****
  • Posts: 2952
  • POKE 54296,15
    • Eye-Candy Controls
Re: Singleton pattern
« Reply #8 on: February 01, 2013, 04:31:56 pm »
@ Taazz, Circular:
Yes, it's a little mix. class constructor & class destructor are replcement of initialization and finalization.

If you don't want the auto-create and you responsibly free all singleton's instances (which is good habit), then you can remove class destructor at all and use only simple class constr.:

Code: [Select]
class constructor TSingleton.CreateSingleton;
begin
  RefCounter:=0;
end;

I mixed it 'cause I taken the code from my project where I wanted to have only one instance from beginning to end of my program.
So everyone can modify it for his needs.

The source is a embarcadero website (some blog) and it is now blocked of some reason.
Lazarus 2.1.0 r64044 FPC 3.3.1 r40507 x86_64-linux-qt Chakra, Qt 4.8.7/5.13.2, Plasma 5.17.3
Lazarus 1.8.2 r57369 FPC 3.0.4 i386-win32-win32/win64 Wine 3.21

Try Eye-Candy Controls: https://sourceforge.net/projects/eccontrols/files/

circular

  • Hero Member
  • *****
  • Posts: 3505
    • Personal webpage
Re: Singleton pattern
« Reply #9 on: February 01, 2013, 04:39:37 pm »
For a singleton without counting, I would propose this :
Code: [Select]
unit Unit2;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

type

  { TSingletonObject }

  TSingletonObject = class
  private
    class var FDestroying: boolean;
    class var FInstance: TSingletonObject;
    class function GetInstance: TSingletonObject; static;
    class destructor DestroyInstance;
  public
    constructor Create;
    destructor Destroy; override;
    class property Instance: TSingletonObject read GetInstance;
  end;

implementation

uses Dialogs;

{ TSingletonObject }

class function TSingletonObject.GetInstance: TSingletonObject; static;
begin
  if FInstance = nil then
    FInstance := TSingletonObject.Create;
  result := FInstance;
end;

class destructor TSingletonObject.DestroyInstance;
begin
  if FInstance <> nil then
  begin
    FDestroying := True;
    FInstance.Destroy;
  end;
end;

constructor TSingletonObject.Create;
begin
  MessageDlg('TSingletonObject.Create',mtInformation,[mbOk],0);
end;

destructor TSingletonObject.Destroy;
begin
  if not FDestroying then
    raise Exception.Create('You cannot destroy a singleton');
  MessageDlg('TSingletonObject.Destroy',mtInformation,[mbOk],0);
  inherited Destroy;
end;

end.
Conscience is the debugger of the mind

Blaazen

  • Hero Member
  • *****
  • Posts: 2952
  • POKE 54296,15
    • Eye-Candy Controls
Re: Singleton pattern
« Reply #10 on: February 01, 2013, 04:41:16 pm »
@ circular (post from  04:29:59 pm )

Yes, of course, if you need it for yourself, you can do it this way.

But what is someone use you class? He will declare:
var
  SingletonObjectInstance1: TSingletonObject;
  SingletonObjectInstance2: TSingletonObject;
  SingletonObjectInstance3: TSingletonObject;

and create three new instances. And it will not be singleton anymore. Point is that even if you declare it 1000 times and you try to create 1000 instances, all of them points to only one.
Typical usage is keyboard input or similar.
Lazarus 2.1.0 r64044 FPC 3.3.1 r40507 x86_64-linux-qt Chakra, Qt 4.8.7/5.13.2, Plasma 5.17.3
Lazarus 1.8.2 r57369 FPC 3.0.4 i386-win32-win32/win64 Wine 3.21

Try Eye-Candy Controls: https://sourceforge.net/projects/eccontrols/files/

circular

  • Hero Member
  • *****
  • Posts: 3505
    • Personal webpage
Re: Singleton pattern
« Reply #11 on: February 01, 2013, 04:47:27 pm »
Declaring multiple variables doesn't change anything. But of course, you could still call the Create constructor.

Ok, so how about that :
Code: [Select]
unit Unit2;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

type

  { TSingletonObject }

  TSingletonObject = class
  private
    class var FCreating, FDestroying: boolean;
    class var FInstance: TSingletonObject;
    class function GetInstance: TSingletonObject; static;
    class destructor DestroyInstance;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    class property Instance: TSingletonObject read GetInstance;
  end;

implementation

uses Dialogs;

{ TSingletonObject }

class function TSingletonObject.GetInstance: TSingletonObject; static;
begin
  if FInstance = nil then
  begin
    FCreating := true;
    try
      FInstance := TSingletonObject.Create;
    finally
      FCreating := false;
    end;
  end;
  result := FInstance;
end;

class destructor TSingletonObject.DestroyInstance;
begin
  if FInstance <> nil then
  begin
    FDestroying := True;
    FInstance.Destroy;
  end;
end;

constructor TSingletonObject.Create;
begin
  if not FCreating then
    raise Exception.Create('You cannot create a singleton');
  MessageDlg('TSingletonObject.Create',mtInformation,[mbOk],0);
end;

destructor TSingletonObject.Destroy;
begin
  if not FDestroying then
    raise Exception.Create('You cannot destroy a singleton');
  MessageDlg('TSingletonObject.Destroy',mtInformation,[mbOk],0);
  inherited Destroy;
end;

end.
Conscience is the debugger of the mind

circular

  • Hero Member
  • *****
  • Posts: 3505
    • Personal webpage
Re: Singleton pattern
« Reply #12 on: February 01, 2013, 05:03:09 pm »
Following the first idea that you proposed, not counting, I would do that :
Code: [Select]
unit Unit2;
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

type
  { TSingleton }

  TSingleton = class
  strict private
    class var FDestroying: boolean;
    class var FInstance: TSingleton;
    class destructor DestroySingleton;
  protected
    procedure Initialize; virtual;
    procedure Finalize; virtual;
  public
    class function NewInstance: TObject; override;
    procedure FreeInstance; override;
  end;

implementation

uses Dialogs;

class destructor TSingleton.DestroySingleton;
begin
  FDestroying := True;
  FInstance.Free;
end;

procedure TSingleton.Initialize;
begin
  MessageDlg('TSingleton.Initialize',mtInformation,[mbOk],0);
end;

procedure TSingleton.Finalize;
begin
  MessageDlg('TSingleton.Finalize',mtInformation,[mbOk],0);
end;

procedure TSingleton.FreeInstance;
begin
  if FDestroying then
  begin
    Finalize;
    inherited FreeInstance;
  end;
end;

class function TSingleton.NewInstance: TObject;
begin
  if not assigned(FInstance) then
  begin
    FInstance := TSingleton(inherited NewInstance);
    FInstance.Initialize;
  end;
  Result:= FInstance;
end;

end.

You can derive this class, overriding Initialize and Finalize functions for your needs.
Conscience is the debugger of the mind

taazz

  • Hero Member
  • *****
  • Posts: 5365
Re: Singleton pattern
« Reply #13 on: February 01, 2013, 05:37:02 pm »
Ok after reading http://blogs.embarcadero.com/abauer/2009/09/04/38899 it seems that class constructors/destructors are executed only once when the program is loaded/unloaded so most of my concerns are addressed the only problem I see is in the class destructor where I would write it like this.
Code: [Select]

class destructor TSingleton.DestroySingleton;
begin
  if Assigned(Singleton) then
    Singleton.Free;
end;



especially taking in to account the fact that the singleton variable is set to nil before calling the inherited FreeInstance method. Everything else seems to check out although I would remove the class constructor completely I do not like automatic object creation especially on initialization.
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

taazz

  • Hero Member
  • *****
  • Posts: 5365
Re: Singleton pattern
« Reply #14 on: February 01, 2013, 05:50:32 pm »
I have noticed a Refcounter-phobia on this groups which is some what reasonable as it does have a impact on the application speed but on this occasion it is just a creation counter so the speed issues are so low that they will probably not even register. It is a form garbage collection process which is required if you want to be able to free the object when is not used any more. I would thing that being able to decide if the object will be kept in memory or not is something positive and I do not see any reason to remove it.


Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

 

TinyPortal © 2005-2018