* Ada 2005: Attempting to create a useful subject/observer pattern
@ 2006-10-24 21:01 Lucretia
2006-10-24 21:08 ` Lucretia
` (3 more replies)
0 siblings, 4 replies; 5+ messages in thread
From: Lucretia @ 2006-10-24 21:01 UTC (permalink / raw)
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;
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: Ada 2005: Attempting to create a useful subject/observer pattern
2006-10-24 21:01 Ada 2005: Attempting to create a useful subject/observer pattern Lucretia
@ 2006-10-24 21:08 ` Lucretia
2006-10-25 2:01 ` Adam Beneschan
` (2 subsequent siblings)
3 siblings, 0 replies; 5+ messages in thread
From: Lucretia @ 2006-10-24 21:08 UTC (permalink / raw)
P.S: We' already discussed replacing the first generic parameter with
an Ada.Tags.Tag. ;D
Luke.
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: Ada 2005: Attempting to create a useful subject/observer pattern
2006-10-24 21:01 Ada 2005: Attempting to create a useful subject/observer pattern Lucretia
2006-10-24 21:08 ` Lucretia
@ 2006-10-25 2:01 ` Adam Beneschan
2006-10-25 8:22 ` Dmitry A. Kazakov
2006-10-25 16:29 ` Matthew Heaney
3 siblings, 0 replies; 5+ messages in thread
From: Adam Beneschan @ 2006-10-25 2:01 UTC (permalink / raw)
Lucretia wrote:
> 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:
I'll bite, but I'm not completely familiar with some of the new rules
yet, and I had to look them up. So I could have easily gotten
something wrong.
> 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
This looks like a compiler problem, although since the declaration of
the generic formal subprogram Update is illegal anyway, it's hard to
tell what the compiler "should" have done.
> 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
In the body of Test_Observers2, the second actual parameter to
Notify_Mouse_Click has type Mouse_Events.Mouse_Event; but the second
formal parameter has type Events.Event (as it's coded in the
declaration of the Notify generic). Was the second parameter to Notify
(and probably Update, as well) supposed to be Matching_Event?
> my_observer.ads:10:03: (Ada 2005) interface subprogram "On_Mouse_Click"
> must be abstract or null
This looks like a compiler problem.
> subjects.ads:15:10: (Ada 2005) interface subprogram "Update" must be
> abstract or null
This definitely looks like a compiler problem.
> subjects.ads:15:20: operation can be dispatching in only one type
This is a violation of RM05 12.6(8.4); it appears from your second post
that you already figured that out, though.
By the way: what is this? Oops.
if Observer_Lists.Element(Current)'Class = Matching_Event'Class then
...
-- Adam
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: Ada 2005: Attempting to create a useful subject/observer pattern
2006-10-24 21:01 Ada 2005: Attempting to create a useful subject/observer pattern Lucretia
2006-10-24 21:08 ` Lucretia
2006-10-25 2:01 ` Adam Beneschan
@ 2006-10-25 8:22 ` Dmitry A. Kazakov
2006-10-25 16:29 ` Matthew Heaney
3 siblings, 0 replies; 5+ messages in thread
From: Dmitry A. Kazakov @ 2006-10-25 8:22 UTC (permalink / raw)
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
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: Ada 2005: Attempting to create a useful subject/observer pattern
2006-10-24 21:01 Ada 2005: Attempting to create a useful subject/observer pattern Lucretia
` (2 preceding siblings ...)
2006-10-25 8:22 ` Dmitry A. Kazakov
@ 2006-10-25 16:29 ` Matthew Heaney
3 siblings, 0 replies; 5+ messages in thread
From: Matthew Heaney @ 2006-10-25 16:29 UTC (permalink / raw)
Lucretia wrote:
> 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.
You can try something I wrote a few years ago:
http://www.adapower.com/index.php?Command=Class&ClassID=Patterns&CID=272
http://www.adapower.com/index.php?Command=Class&ClassID=Patterns&CID=273
There are other articles on that page:
http://www.adapower.com/index.php?Command=Class&ClassID=Patterns&Title=Patterns
I haven't updated these for Ada05, but I assume adapting it to use the
new interface types wouldn't be too difficult.
-Matt
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2006-10-25 16:29 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2006-10-24 21:01 Ada 2005: Attempting to create a useful subject/observer pattern Lucretia
2006-10-24 21:08 ` Lucretia
2006-10-25 2:01 ` Adam Beneschan
2006-10-25 8:22 ` Dmitry A. Kazakov
2006-10-25 16:29 ` Matthew Heaney
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox