Ada 2005: Attempting to create a useful subject/observer pattern

Ada 2005: Attempting to create a useful subject/observer pattern

[Lucretia]

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;

Re: Ada 2005: Attempting to create a useful subject/observer pattern

[Lucretia]

P.S: We' already discussed replacing the first generic parameter with
an Ada.Tags.Tag. ;D

Luke.

Re: Ada 2005: Attempting to create a useful subject/observer pattern

[Adam Beneschan]

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

Re: Ada 2005: Attempting to create a useful subject/observer pattern

[Dmitry A. Kazakov]

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

Re: Ada 2005: Attempting to create a useful subject/observer pattern

[Matthew Heaney]

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