Bug 29015 - Ada 2005 observer pattern with mutually dependent packages and containers produces compiler error
Ada 2005 observer pattern with mutually dependent packages and containers pro...
Status: RESOLVED FIXED
Product: gcc
Classification: Unclassified
Component: ada
4.1.1
: P3 normal
: 4.4.0
Assigned To: Samuel Tardieu
: ice-on-invalid-code
Depends on:
Blocks:
  Show dependency treegraph
 
Reported: 2006-09-11 10:20 UTC by Luke A. Guest
Modified: 2008-04-16 12:44 UTC (History)
2 users (show)

See Also:
Host: i686-pc-linux-gnu
Target: i686-pc-linux-gnu
Build: i686-pc-linux-gnu
Known to work:
Known to fail:
Last reconfirmed: 2008-04-09 20:40:46


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description Luke A. Guest 2006-09-11 10:20:42 UTC
$ 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;
Comment 1 Luke A. Guest 2006-09-17 19:42:20 UTC
Using the current SVN source (17/09/06) I get a slightly different error (with the same source):

gcc -c -gnat05 test_observers.adb
+===========================GNAT BUG DETECTED==============================+
| 4.2.0 20060917 (experimental) (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
Comment 2 Luke A. Guest 2006-09-18 16:11:57 UTC
Seems this was an error based on the use of a limited view of a type. I don't know whether this is actually allowed in the Ada 2005 standard, i.e passing a reference to a limited view to a container? Should this bug be left open?

Luke.
Comment 3 Laurent GUERBY 2006-09-18 17:55:33 UTC
Confirmed.

$ gcc -c -gnat05 test_observers.adb
+===========================GNAT BUG DETECTED==============================+
| 4.2.0 20060915 (experimental) (x86_64-unknown-linux-gnu) Assert_Failure atree.adb:812|
| Error detected at subjects.ads:19:3                                      |

I'm not sure this is valid too, so I'm tagging this as ICE on invalid code (in all cases this is a bug since the compiler should never ICE).
Comment 4 Samuel Tardieu 2007-12-07 14:01:58 UTC
Confirmed on SVN trunk

+===========================GNAT BUG DETECTED==============================+
| 4.3.0 20071207 (experimental) (i686-pc-linux-gnu) Assert_Failure atree.adb:962|
| Error detected at subjects.ads:19:3                                      |
Comment 5 Luke A. Guest 2008-04-09 19:45:19 UTC
This is still a problem on 4.4.0 trunk.

Luke.
Comment 6 Ludovic Brenta 2008-04-09 20:10:34 UTC
Reduced test case:

package Observers is
  type Observer is tagged null record;
  type Observer_Access is access all Observers.Observer'Class;
end Observers;

limited with Observers;
with Ada.Containers.Doubly_Linked_Lists;
package Subjects is
  function Equals(Left, Right : access Observers.Observer) return Boolean;
  package Observer_Lists is new
    Ada.Containers.Doubly_Linked_Lists(Observers.Observer_Access, Equals);
end Subjects;

with Observers; -- this line triggers the bug
package body Subjects is
   function Equals(Left, Right : access Observers.Observer) return Boolean is
   begin
      return False;
   end Equals;
end Subjects;

With the line that triggers the bug:

gcc-4.1 -c -gnat05 subjects.adb
+===========================GNAT BUG DETECTED==============================+
| 4.1.3 20070518 (prerelease) (Debian 4.1.2-8) (x86_64-pc-linux-gnu)       |
| Assert_Failure atree.adb:812                                             |
| Error detected at subjects.ads:8:3                                       |

gcc-4.3 -c -gnat05 subjects.adb
+===========================GNAT BUG DETECTED==============================+
| 4.3.1 20080401 (prerelease) (x86_64-pc-linux-gnu) Assert_Failure atree.adb:886|
| Error detected at subjects.ads:8:3                                       |


Without the line that triggers the bug:

gcc-4.1 -c -gnat05 subjects.adb
subjects.ads:9:49: premature use of incomplete type
subjects.ads:9:49: instantiation abandoned

gcc-4.3 -c -gnat05 subjects.adb
subjects.ads:9:49: premature use of incomplete type
subjects.ads:9:49: instantiation abandoned
Comment 7 Ludovic Brenta 2008-04-09 20:25:28 UTC
Further reduced test case: replace observers.ads with:

package Observers is
   type Observer is new Integer;
   type Observer_Access is access Observer;
end Observers;

and the bug is still there.
Comment 8 Samuel Tardieu 2008-04-09 20:40:46 UTC
Yes, the bug manifests when the view on the type is limited at this point *but* we know the underlying type (because of a non-limited with for example). This triggers it if you compile p2.adb:

package P1 is
   type T is null record;
end P1;
limited with P1;
package P2 is
   pragma Elaborate_Body;
   generic
      type T is private;
   package G is end G;
   package I1 is new G (P1.T);
end P2;
with P1;
package body P2 is end P2;

I'm testing a fix.
Comment 9 Samuel Tardieu 2008-04-16 12:38:25 UTC
Subject: Bug 29015

Author: sam
Date: Wed Apr 16 12:37:38 2008
New Revision: 134345

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=134345
Log:
    gcc/ada/
	PR ada/29015
	* sem_ch12.adb (Instantiate_Type): Check whether the full view of
	the type is known instead of the underlying type.

    gcc/testsuite/
	PR ada/29015
	* gnat.dg/incomplete1.ads, gnat.dg/incomplete2.ads,
	gnat.dg/incomplete2.adb: New.

Added:
    trunk/gcc/testsuite/gnat.dg/incomplete1.ads
    trunk/gcc/testsuite/gnat.dg/incomplete2.adb
    trunk/gcc/testsuite/gnat.dg/incomplete2.ads
Modified:
    trunk/gcc/ada/ChangeLog
    trunk/gcc/ada/sem_ch12.adb
    trunk/gcc/testsuite/ChangeLog

Comment 10 Samuel Tardieu 2008-04-16 12:44:41 UTC
This is fixed in the current GCC SVN.