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!wns13feed!worldnet.att.net!attbi_s03.POSTED!53ab2750!not-for-mail From: "Steve" Newsgroups: comp.lang.ada References: <%Fi1d.245967$OR2.11136154@news3.tin.it> <14p6ezf3vze8j$.j05arkr066wi.dlg@40tude.net> Subject: Re: Ada Singleton Pattern X-Priority: 3 X-MSMail-Priority: Normal X-Newsreader: Microsoft Outlook Express 6.00.2800.1437 X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1441 Message-ID: NNTP-Posting-Host: 24.21.42.251 X-Complaints-To: abuse@comcast.net X-Trace: attbi_s03 1095128973 24.21.42.251 (Tue, 14 Sep 2004 02:29:33 GMT) NNTP-Posting-Date: Tue, 14 Sep 2004 02:29:33 GMT Organization: Comcast Online Date: Tue, 14 Sep 2004 02:29:33 GMT Xref: g2news1.google.com comp.lang.ada:3706 Date: 2004-09-14T02:29:33+00:00 List-Id: 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" wrote in message news:ci4pok$l9u$1@titan.btinternet.com... > "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; > >