From: Luca Stasio <stasio2000@tin.it>
Subject: Re: Ada Singleton Pattern
Date: Tue, 14 Sep 2004 13:57:31 GMT
Date: 2004-09-14T13:57:31+00:00 [thread overview]
Message-ID: <fNC1d.251425$OR2.11336651@news3.tin.it> (raw)
In-Reply-To: <ci4pok$l9u$1@titan.btinternet.com>
Martin Dowie wrote:
> "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;
>
>
Thanx a lot
next prev parent reply other threads:[~2004-09-14 13:57 UTC|newest]
Thread overview: 33+ messages / expand[flat|nested] mbox.gz Atom feed top
2004-09-13 15:04 Ada Singleton Pattern Luca Stasio
2004-09-13 15:33 ` Dmitry A. Kazakov
2004-09-13 16:18 ` Luca Stasio
2004-09-13 17:01 ` Luca Stasio
2004-09-13 18:43 ` Martin Dowie
2004-09-13 19:37 ` Martin Dowie
2004-09-14 2:29 ` Steve
2004-09-14 8:52 ` Martin Dowie
2004-09-14 12:46 ` Jim Rogers
2004-09-14 13:57 ` Luca Stasio [this message]
2004-09-13 20:38 ` Georg Bauhaus
2004-09-14 8:17 ` Dmitry A. Kazakov
2004-09-14 13:56 ` Luca Stasio
2004-09-14 14:21 ` Florian Weimer
2004-09-14 14:48 ` Dmitry A. Kazakov
2004-09-14 15:04 ` Florian Weimer
2004-09-15 7:33 ` Dmitry A. Kazakov
2004-09-16 6:48 ` Florian Weimer
2004-09-16 7:45 ` Dmitry A. Kazakov
2004-09-14 15:38 ` Luca Stasio
2004-09-14 16:32 ` Florian Weimer
2004-09-14 17:43 ` Luca Stasio
2004-09-15 7:27 ` Martin Dowie
2004-09-15 19:38 ` Luca Stasio
2004-09-15 5:43 ` Matthew Heaney
2004-09-15 19:38 ` Luca Stasio
2004-09-18 21:47 ` Pylinius
2004-09-19 4:19 ` Matthew Heaney
2004-09-20 3:03 ` Pylinius
2004-09-23 7:35 ` Luca Stasio
2004-09-27 5:22 ` Pylinius
2004-09-27 8:05 ` Luca Stasio
2004-10-05 17:55 ` Luca Stasio
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox