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.0 required=5.0 tests=BAYES_00,FILL_THIS_FORM, FILL_THIS_FORM_LOAN,FREEMAIL_FROM autolearn=no autolearn_force=no version=3.4.4 X-Google-Thread: 103376,9a4cc01431944b26,start X-Google-Attributes: gid103376,public X-Google-Language: ENGLISH,ASCII-7-bit Path: g2news2.google.com!postnews.google.com!f16g2000cwb.googlegroups.com!not-for-mail From: "Lucretia" Newsgroups: comp.lang.ada Subject: Ada 2005: Attempting to create a useful subject/observer pattern Date: 24 Oct 2006 14:01:50 -0700 Organization: http://groups.google.com Message-ID: <1161723710.859323.228560@f16g2000cwb.googlegroups.com> NNTP-Posting-Host: 62.56.59.181 Mime-Version: 1.0 Content-Type: text/plain; charset="iso-8859-1" X-Trace: posting.google.com 1161723716 1961 127.0.0.1 (24 Oct 2006 21:01:56 GMT) X-Complaints-To: groups-abuse@google.com NNTP-Posting-Date: Tue, 24 Oct 2006 21:01:56 +0000 (UTC) User-Agent: G2/1.0 X-HTTP-UserAgent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8.0.5) Gecko/20060903 Firefox/1.5.0.5,gzip(gfe),gzip(gfe) Complaints-To: groups-abuse@google.com Injection-Info: f16g2000cwb.googlegroups.com; posting-host=62.56.59.181; posting-account=G-J9fgwAAADgpzBiEyy5tO4f8MX5fbpw Xref: g2news2.google.com comp.lang.ada:7188 Date: 2006-10-24T14:01:50-07:00 List-Id: Hi, 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. 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'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 Thanks, Luke. 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; 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; 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 Update(Observer_Lists.Element(Current), Event); --Observer_Lists.Element(Current).Update; Current := Observer_Lists.Next(Current); end if; end loop; end Notify; -- 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; 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; procedure Notify(Self : in Subject; Event : in Events.Event); 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;