From: "Martin Dowie" <martin.dowie@btopenworld.com>
Subject: Re: Ada Singleton Pattern
Date: Mon, 13 Sep 2004 18:43:33 +0000 (UTC)
Date: 2004-09-13T18:43:33+00:00 [thread overview]
Message-ID: <ci4pok$l9u$1@titan.btinternet.com> (raw)
In-Reply-To: hnk1d.246585$OR2.11156430@news3.tin.it
"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;
next prev parent reply other threads:[~2004-09-13 18:43 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 [this message]
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
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