Singleton pattern

{
  Implements singleton pattern by using FreePascal's property feature.
  
  A global block can declare properties, just as they could be defined 
  in a class. The difference is that the global property does not need 
  a class instance: there is only one instance of this property. 

  In this case the actual singleton is hidden behind a local writeable
  const. This is actually stored in global space, but only accessible from 
  within its local constant. Since the property has only read access it
  makes that it can only be accessed read-only: a singleton.

  You must make sure the underlying class is free'd.
  That is no problem, because you can call free on the property.

  important note:

  Invoke<T> returns a lazily-created singleton instance for type T.
  The instance is intended to live for the lifetime of the process.
  Callers must not free the returned object unless at process end. 
  It is owned by this unit/runtime pattern and is released only at 
  process shutdown, or intentionally leaked when relying on OS cleanup.
  E,g. for services daemons, let the OS clean up and never call free except 
  just before process end.

  This helper is not meant for scoped, resettable, or short-lived instances.
  That would be contrary to the true meaning of a singleton.

  If not agreed, blame Thaddy

}
unit singletons;
{$mode objfpc}{$H+}
interface
uses 
  classes, syncobjs;
var
  cs:TCriticalSection;
    
  generic function Invoke<T:class>:T;
    
implementation

generic function Invoke<T>: T;
{$push}{$J+}const value: T = nil;{$pop}
begin
  cs.Acquire;
  try
    if value = nil then
      value := T.Create;
    Result := value;
  finally
    cs.Release;
  end;
end;
  
initialization
  cs := TCriticalSection.Create;
finalization
  cs.free;
end.

And demos:

program simplesingleton;
{$mode objfpc}
uses classes,singletons;

function getstringlist:TStringlist;
begin
  Result := specialize Invoke<TStringlist>;
end;

property SingletonList:TStringlist read getstringlist;

begin
  Singletonlist.add('Some text');
  writeln(Singletonlist.text);
  Singletonlist.free;
end.

program SingletonExample;

{$mode objfpc}{$H+}

uses
  SysUtils, Singletons;

type
  TSettings = class
  private
    FName: String;
    FCounter: Integer;
  public
    constructor Create;
    procedure Touch;
    property Name: String read FName write FName;
    property Counter: Integer read FCounter;
  end;

constructor TSettings.Create;
begin
  inherited Create;
  FName := 'default settings';
  FCounter := 0;
  Writeln('TSettings.Create called');
end;

procedure TSettings.Touch;
begin
  Inc(FCounter);
end;

function GetSettings: TSettings;
begin
  Result := specialize Invoke<TSettings>;
end;

property Settings: TSettings read GetSettings;

begin
  Settings.Name := 'app settings';
  Settings.Touch;
  Settings.Touch;

  Writeln(Settings.Name);
  Writeln('Counter: ', Settings.Counter);

  if Settings = GetSettings then
    Writeln('Same instance');
  Settings.free;
end.