Re: Ada Singleton Pattern

["Steve" <nospam_steved94@comcast.net>]

Isn't it kind of silly to build a semaphore using a protected object?

Why not:
   protected SingleGet is
      procedure Get( ok : out Boolean );
   private
      Is_First : Boolean := TRUE;
   end SingleGet;

   protected body SingleGet is
      procedure Get( ok : out Boolean ) do
      begin
        ok := Is_First;
        Is_First := FALSE;
      end Get;
   end SingleGet;

And then in Initialize:

      if Thread_Safe then
         SingleGet.Get( ok );
      else
        Number_Created := Number_Created + 1;
        gotIt := Number_Created = 1;
      end if;
      if not ok then
        Raise_Exception
           (Program_Error'Identity,
            "Only one instance of a Singleton is allowed at a time");
      end if;

Although it's unclear why a counter is used.

I started programming real-time muti-tasking systems using semaphores,
events, etc.  When I first started using Ada, I created semaphores using a
protected type and built the little houses of cards I was accustomed to.
Eventually I learned that there was a reason for having something other than
semaphores and events.  If you use them correctly you'll find you eliminate
problems of having semaphores that never get released, etc.

Steve
(The Duck)

"Martin Dowie" <martin.dowie@btopenworld.com> wrote in message
news:ci4pok$l9u$1@titan.btinternet.com...
> "Luca Stasio" <stasio2000@tin.it> wrote in message
> news:hnk1d.246585$OR2.11156430@news3.tin.it...
> > Know, sorry... but, there is a way to create a Singleton Class from wich
> > derive and create concrete singleton classes?
> >  I mean: (1) a Singleton class (2) a DatbaseAccessSingleton or a
> > NetworkAccessSingleton or... heach one with its own methods but sharing
> > the Singleton behaviour.
>
> Here's one I use. It's not the complete source, which also includes
> interleavable singletons and limited singletons (also can be
interleavable).
> Examples are embedded in the package spec (in an AdaBrowse format, of
> course).
>
> I may post them on my web page if anyone is interested.
>
> Cheers
>
> -- Martin
>
>
> --  generic_singletons.ads
>
> -- (c) 2003, Martin M. Dowie
> --
> -- Instantiate a new version of this package for each type you want to be
> -- a singleton.
> --
> -- Example
> --! with Generic_Singletons;
> --!
> --! package My_Stuff is
> --!
> --! type My_Type is private;
> --!
> --! ...
> --!
> --! private
> --!
> --! package Root_Singleton is
> --! new Generic_Singletons;
> --!
> --! type My_Type
> --! is new Root_Singleton.Singleton with ...;
> --!
> --! end My_Stuff;
> --!
> --!
> --! with My_Stuff;
> --!
> --! procedure Test is
> --! S1 : My_Stuff.My_Type; -- Should be the one and only
> --! S2 : My_Stuff.My_Type; -- Will raise Program_Error here
> --! begin
> --! null;
> --! end Test;
> pragma License (Modified_GPL);
> with Ada.Finalization;
> generic
>    Thread_Safe : in Boolean := False;
> package Generic_Singletons is
>    type Singleton is tagged private;
>    -- Derive your type from this type to ensure that only one instance
>    -- of your type can exist within a partition <STRONG>ever</STRONG>.
>    type Pointer is access all Singleton'Class;
>    type Reference is access constant Singleton'Class;
> private
>    Number_Created : Natural := 0;
>    pragma Atomic (Number_Created);
>    type Singleton is
>       new Ada.Finalization.Controlled with null record;
>    procedure Initialize (S : in out Singleton);
>    protected Semaphore is
>       entry Lock;
>       entry Unlock;
>    private
>       Is_Locked : Boolean := False;
>    end Semaphore;
> end Generic_Singletons;
>
> -- generic_singletons.adb
>
> with Ada.Exceptions; use Ada.Exceptions;
> package body Generic_Singletons is
>    protected body Semaphore is
>       entry Lock when not Is_Locked is
>       begin
>          Is_Locked := True;
>       end Lock;
>       entry Unlock when Is_Locked is
>       begin
>          Is_Locked := False;
>       end Unlock;
>    end Semaphore;
>
>    ----------------
>    -- Initialize --
>    ----------------
>    procedure Initialize (S : in out Singleton) is
>       pragma Warnings (Off, S);
>    begin
>       if Thread_Safe then
>          Semaphore.Lock;
>       end if;
>       Number_Created := Number_Created + 1;
>       if Thread_Safe then
>          Semaphore.Unlock;
>       end if;
>       if Number_Created > 1 then
>          Raise_Exception
>             (Program_Error'Identity,
>              "Only one instance of a Singleton is allowed at a time");
>       end if;
>    end Initialize;
> end Generic_Singletons;
>
>