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=-0.3 required=5.0 tests=BAYES_00, REPLYTO_WITHOUT_TO_CC autolearn=no autolearn_force=no version=3.4.4 X-Google-Thread: 103376,9a4cc01431944b26 X-Google-Attributes: gid103376,public X-Google-Language: ENGLISH,ASCII-7-bit Path: g2news2.google.com!news4.google.com!news2.volia.net!newsfeed.utanet.at!newsfeed01.chello.at!newsfeed.arcor.de!newsspool3.arcor-online.net!news.arcor.de.POSTED!not-for-mail From: "Dmitry A. Kazakov" Subject: Re: Ada 2005: Attempting to create a useful subject/observer pattern Newsgroups: comp.lang.ada User-Agent: 40tude_Dialog/2.0.15.1 MIME-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit Reply-To: mailbox@dmitry-kazakov.de Organization: cbb software GmbH References: <1161723710.859323.228560@f16g2000cwb.googlegroups.com> Date: Wed, 25 Oct 2006 10:22:54 +0200 Message-ID: NNTP-Posting-Date: 25 Oct 2006 10:22:54 CEST NNTP-Posting-Host: 038123ef.newsspool2.arcor-online.net X-Trace: DXC=mJJYiR\BH3YRWRlm73?JYK^DNcfSJ;bb[UFCTGGVUmh?TN\HXHJ4e80^`XXYS2HOVJ[ X-Complaints-To: usenet-abuse@arcor.de Xref: g2news2.google.com comp.lang.ada:7194 Date: 2006-10-25T10:22:54+02:00 List-Id: On 24 Oct 2006 14:01:50 -0700, Lucretia wrote: > Like the subject states, I'm trying to implement a usable > subject/observer pattern which is an extension of the GoF original and > something closer to Java's Listeners. yuck... > The idea was to use the code in a > gui library. After talking on IRC (#Ada) and working with the guys > there (Baldrick ;D), it was noted that GNAT is flawed in it's > interfaces, but I'd like to know if anyone here can indicate whether > the code is wrong and GNAT should accept it or not. I cannot comment on compiler bugs, I am not a language lawyer. So I only comment on to the code. > I'm using FSF GNAT from GCC 4.1.1 and the errors are: > > gnatmake -gnat05 test_observers2.adb > gcc -c -gnat05 test_observers2.adb > test_observers2.adb:16:34: (Ada 2005) interface subprogram "Update" > must be abstract or null > test_observers2.adb:23:31: expected private type "Event" defined at > events.ads:5test_observers2.adb:23:31: found private type "Mouse_Event" > defined at mouse_events.ads:5 > my_observer.ads:10:03: (Ada 2005) interface subprogram "On_Mouse_Click" > must be abstract or null > subjects.ads:15:10: (Ada 2005) interface subprogram "Update" must be > abstract or null > subjects.ads:15:20: operation can be dispatching in only one type > gnatmake: "test_observers2.adb" compilation error > > All code below is GPL'd and can be gnatchopped: > > with Ada.Finalization; > package Events is > type Event is new Ada.Finalization.Controlled with private; > private > type Event is new Ada.Finalization.Controlled with null record; > end Events; > > with Events; > package Mouse_Events is > type Mouse_Event is new Events.Event with private; > private > type Mouse_Event is new Events.Event with null record; > end Mouse_Events; > > with Mouse_Events; > with Observers; > package Mouse_Observers is > type Mouse_Observer is interface and Observers.Observer; > procedure On_Mouse_Click(Self : in Mouse_Observer; Event : in > Mouse_Events.Mouse_Event) is null; I suppose this should be: procedure On_Mouse_Click ( Self : in Mouse_Observer; Event : in Mouse_Events.Mouse_Event'Class ) is null; > end Mouse_Observers; > > with Ada.TexT_IO; > package body My_Observer is > -- procedure Update(Self : in My_Observer_Type) is > -- begin > -- Ada.TexT_IO.Put_Line("[My_Observer.Update]"); > -- end Update; > > procedure On_Mouse_Click(Self : in Mouse_Observer; Event : in > Mouse_Events.Mouse_Event) is > begin > Ada.TexT_IO.Put_Line("[My_Observer.On_Mouse_Click]"); > end On_Mouse_Click; > end My_Observer; > > with Mouse_Observers; > with Mouse_Events; > package My_Observer is > type My_Observer_Type is new Mouse_Observers.Mouse_Observer with > private; > overriding > -- procedure Update(Self : in My_Observer_Type); > procedure On_Mouse_Click(Self : in Mouse_Observers.Mouse_Observer; > Event : in Mouse_Events.Mouse_Event); > > private > type My_Observer_Type is new Mouse_Observers.Mouse_Observer with null > record; > end My_Observer; > > package Observers is > type Observer is interface; Why don't you define abstract Notify on Observer? Why Observer need to be an interface? What does guarantee detachment of observers upon finalization? > type Observer_Access is access all Observer'Class; > end Observers; > > with Observers; > > package body Subjects is > use type Observer_Lists.Cursor; > -- Add an observer to this subject's internal list. > procedure Attach(Self : in out Subject'Class; Observer : access > Observers.Observer'Class) is > begin > Self.Observer_List.Append(New_Item => > Observers.Observer_Access(Observer)); > end Attach; > > -- Remove an observer from this subject's internal list. > procedure Detach(Self : in out Subject'Class; Observer : access > Observers.Observer'Class) is > > Position : Observer_Lists.Cursor := > Self.Observer_List.Find(Observers.Observer_Access(Observer)); > begin > if Position /= Observer_Lists.No_Element then > Self.Observer_List.Delete(Position); > end if; > end Detach; > > -- Notify all observers who are monitoring this subject that > something has happened. > procedure Notify(Self : in Subject; Event : in Events.Event) is > > Current : Observer_Lists.Cursor := Self.Observer_List.First; > begin > while Current /= Observer_Lists.No_Element loop > if Observer_Lists.Element(Current)'Class = Matching_Event'Class > then This should be something like: if Observer_Lists.Element (Current) in Matching_Event'Class then However, I would not use a design that queues events to [ultimate] observers. Rather I would queue observers to the event sources. That would save me event filtering issue, as well as crude emulations of multiple dispatch like you tried above. > Update(Observer_Lists.Element(Current), Event); > --Observer_Lists.Element(Current).Update; > Current := Observer_Lists.Next(Current); > end if; > end loop; > end Notify; There is a big problem with traversing the list of observers, while calling notifications. If some of the notification causes a list change? This is a no-no with Ada.Containers. So you have to undertake some actions to ensure that this would never happen. Unfortunately it is necessary to happen. I usually add some parameters to Update, to allow the subscribers to postpone some notifications from the callback. But this is a complex issue for such a small example. > -- function Equals(Left, Right : access Observers.Observer) return > Boolean is > function Equals(Left, Right : Observers.Observer_Access) return > Boolean is > use type Observers.Observer_Access; > begin > if Left = Right then > return True; > end if; > return False; > end Equals; My rule of thumb: If objects have referential identity => they have to be limited. So I would make Observer Limited_Controlled, if I wished to compare pointers to them. > end Subjects; > with Observers; > with Ada.Containers.Doubly_Linked_Lists; > with Ada.Finalization; > with Events; > > package Subjects is > > type Subject is new Ada.Finalization.Limited_Controlled with private; > > procedure Attach(Self : in out Subject'Class; Observer : access > Observers.Observer'Class); > procedure Detach(Self : in out Subject'Class; Observer : access > Observers.Observer'Class); > > generic > type Matching_Event is new Events.Event with private; > with procedure Update(Self : in Observers.Observer; Event : in > Events.Event) is abstract; ... Matching_Event'Class, I suppose. > procedure Notify(Self : in Subject; Event : in Events.Event); procedure Notify(Self : in Subject'Class; Event : in Events.Event'Class); Another empirical rule: if a subprogram takes tagged arguments and is not primitive (or maybe located in a body), then it should be class-wide. And, well, generics to hide type casting ... > private > > function Equals(Left, Right : Observers.Observer_Access) return > Boolean; > > package Observer_Lists is new > Ada.Containers.Doubly_Linked_Lists(Observers.Observer_Access, Equals); > > type Subject is new Ada.Finalization.Limited_Controlled with > record > Observer_List : Observer_Lists.List; > end record; > > end Subjects; > with My_Observer; > with Subjects; > --with Observers; > with Mouse_Events; > > procedure Test_Observers2 is > > -- Obs : Observers.Observer_Access := new > My_Observer.My_Observer_Type; > -- Obs : access Observers.Observer := new > My_Observer.My_Observer_Type; > Obs : aliased My_Observer.My_Observer_Type; > Subject : Subjects.Subject; > Mouse_Event : Mouse_Events.Mouse_Event; > > procedure Notify_Mouse_Click is new Subjects.Notify( > Matching_Event => Mouse_Events.Mouse_Event, > Update => My_Observer.On_Mouse_Click); > > begin > Subject.Attach(Obs'Access); > -- Subject.Attach(Observers.Observer(Obs)'Access); > -- Subject.Notify; > Notify_Mouse_Click(Subject, Mouse_Event); > > end Test_Observers2; -- Regards, Dmitry A. Kazakov http://www.dmitry-kazakov.de