This is the mail archive of the gcc-bugs@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Bug ada/29015] New: Ada 2005 observer pattern with mutually dependent packages and containers produces compiler error


$ uname -a
Linux rogue 2.6.16-gentoo-r13 #1 PREEMPT Tue Aug 1 13:59:12 GMT 2006 i686 AMD
Athlon(TM) XP 2000+ GNU/Linux

$ gcc -v
Using built-in specs.
Target: i686-pc-linux-gnu
Configured with: ../gcc-4.1.1/configure --prefix=/home/laguest/opt/gcc-4.1.1
--enable-libada --enable-languages=c,c++,java,objc,ada
Thread model: posix
gcc version 4.1.1

$ gnatmake -gnat05 -gnatwj test_observers.adb
gcc -c -gnat05 -gnatwj test_observers.adb
+===========================GNAT BUG DETECTED==============================+
| 4.1.1 (i686-pc-linux-gnu) Assert_Failure atree.adb:812                   |
| Error detected at subjects.ads:17:3                                      |
| Please submit a bug report; see http://gcc.gnu.org/bugs.html.            |
| Use a subject line meaningful to you and us to track the bug.            |
| Include the entire contents of this bug box in the report.               |
| Include the exact gcc or gnatmake command that you entered.              |
| Also include sources listed below in gnatchop format                     |
| (concatenated together with no headers between files).                   |
+==========================================================================+

Please include these source files with error report
Note that list may not be accurate in some cases,
so please double check that the problem can still
be reproduced with the set of files listed.

test_observers.adb
my_observer.ads
observers.ads
subjects.ads

compilation abandoned
gnatmake: "test_observers.adb" compilation error

with My_Observer;
with Subjects;

procedure Test_Observers is

  Obs     : Observers.Observer_Access := new My_Observer.My_Observer_Type;
  Subject : Subjects.Subject;

begin

--  Subjects.Attach(Subject, Obs);
  Subject.Attach(Obs);
  Subject.Notify;

end Test_Observers;
package body My_Observer is

  procedure Update(Self : in My_Observer_Type) is

  begin

    Ada.TexT_IO.Put_Line("[My_Observer.Update]");

  end Update;

end My_Observer;
with Observers;

package My_Observer is

  type My_Observer_Type is new Observers.Observer with private;

  procedure Update(Self : in My_Observer_Type);

private

  type My_Observer_Type is new Observers.Observer with null record;

end My_Observer;
limited with Observers;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Finalization;

package Subjects is

  type Subject is new Ada.Finalization.Limited_Controlled with private;

  procedure Attach(Self : in out Subject'Class; Observer : access
Observers.Observer);
  procedure Detach(Self : in out Subject'Class; Observer : access
Observers.Observer);
  procedure Notify(Self : in Subject);

private

  function Equals(Left, Right : access Observers.Observer) 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 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) is

  begin

    Self.Observer_List.Append(New_Item => Observer);

  end Attach;


  -- Remove an observer from this subject's internal list.
  procedure Detach(Self : in out Subject'Class; Observer : access
Observers.Observer) is

    Position : Observer_Lists.Cursor := Self.Observer_List.Find(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) is

    Current : Observer_Lists.Cursor := Self.Observer_List.First;

  begin

    while Current /= Observer_Lists.No_Element loop

      Observer_Lists.Element(Current).Update;

      Current := Observer_Lists.Next(Current);

    end loop;

  end Notify;


  function Equals(Left, Right : access Observers.Observer) return Boolean is

  begin

    if Left = Right then

      return True;

    end if;

    return False;

  end Equals;

end Subjects;
package Observers is

  type Observer is abstract tagged private;
  type Observer_Access is access all Observers.Observer'Class;


  procedure Update(Self : in Observer) is abstract;

private

  type Observer is abstract tagged null record;

end Observers;


-- 
           Summary: Ada 2005 observer pattern with mutually dependent
                    packages and containers produces compiler error
           Product: gcc
           Version: 4.1.1
            Status: UNCONFIRMED
          Severity: blocker
          Priority: P3
         Component: ada
        AssignedTo: unassigned at gcc dot gnu dot org
        ReportedBy: laguest at abyss2 dot demon dot co dot uk
 GCC build triplet: i686-pc-linux-gnu
  GCC host triplet: i686-pc-linux-gnu
GCC target triplet: i686-pc-linux-gnu


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29015


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]