From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,FREEMAIL_FROM autolearn=ham autolearn_force=no version=3.4.4 X-Google-Thread: 103376,54aae3da1cf935cd X-Google-Attributes: gid103376,public X-Google-Language: ENGLISH,ASCII-7-bit Path: g2news1.google.com!news1.google.com!news.glorb.com!newsgate.cistron.nl!news.cambrium.nl!news.cambrium.nl!news2.euro.net!news.mailgate.org!news-out.tin.it!news-in.tin.it!news3.tin.it.POSTED!not-for-mail From: Luca Stasio User-Agent: Mozilla Thunderbird 0.8 (Windows/20040913) X-Accept-Language: en-us, en MIME-Version: 1.0 Newsgroups: comp.lang.ada Subject: Re: Ada Singleton Pattern References: <%Fi1d.245967$OR2.11136154@news3.tin.it> <14p6ezf3vze8j$.j05arkr066wi.dlg@40tude.net> In-Reply-To: Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 7bit Message-ID: Date: Tue, 14 Sep 2004 13:57:31 GMT NNTP-Posting-Host: 80.181.112.41 X-Complaints-To: "Please send abuse reports to abuse@tin.it and technical notifications to newsmaster@tin.it" X-Trace: news3.tin.it 1095170251 80.181.112.41 (Tue, 14 Sep 2004 15:57:31 MET DST) NNTP-Posting-Date: Tue, 14 Sep 2004 15:57:31 MET DST Organization: TIN Xref: g2news1.google.com comp.lang.ada:3717 Date: 2004-09-14T13:57:31+00:00 List-Id: Martin Dowie wrote: > "Luca Stasio" 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 ever. > 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