[Bug ada/19002] New: GNAT BUG DETECTED, unqualified record aggregate triggers

["bauhaus at futureapps dot de" <gcc-bugzilla at gcc dot gnu dot org>]

The code appended below triggers a bug box.

$ gcc -v
Reading specs from /opt/GCC/4/lib/gcc/i686-pc-linux-gnu/4.0.0/specs
Configured with: /opt/gcc/configure --prefix=/opt/GCC/4 --enable-languages=c,ada
--enable-werror
Thread model: posix
gcc version 4.0.0 20041214 (experimental)


The box does not appear if -gnatc is used.
The offending(?) line is in the procedure Space_Info.mark, in the
body of Space_Info. (The file space_info.adb is not listed below the
box but must be present to trigger the bug).
The line has an unqualified record aggregate.
If the aggregate is qualified, the bug box goes away.

The AI302 sources used are as of 2004-12-14 (from the tigris site via CVS).

Systems:
  Debian/GNU testing, 2.6.8-1-686-smp, GCC 4.0.0 as above
(The same error on Debian with gcc 3.4.2-2, 
and W2K, MinGW 1.0? (gcc 3.4.2))


$ gnatmake matter
gcc -c matter.ads
+===========================GNAT BUG DETECTED==============================+
| 4.0.0 20041214 (experimental) (i686-pc-linux-gnu) Assert_Failure sinfo.adb:2474|
| Error detected at space_info.adb:19:48 [matter.ads:5:4]                  |
| Please submit a bug report; see http://gcc.gnu.org/bugs.html.            |
| 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.

matter.ads
space_info.ads
coordinate_system.ads
ai302.ads
ai302-containers.ads
ai302-containers-vectors.ads
list may be incomplete
compilation abandoned
gnatmake: "matter.ads" compilation error
$

(no *.ali files, no *.s files are written)

with Coordinate_System;
with AI302.Containers.Vectors;

generic
   farthest_east_west: Natural := 100;
   -- number of rectangles in the direction

   farthest_north_south: Natural := 100;
   -- number of rectangles in the direction

package Space_Info is

   pragma preelaborate;

   subtype Extent is
     Natural range 1 .. Natural'max(farthest_east_west, farthest_north_south);
   -- possible number of a space cube in one dimension

   package Space is new Coordinate_System (Extent, Dim => 2);


   type Obstacle is (None, Rock);
   --
   for Obstacle'size use 1;


   type Known_Space is
      array(Extent range <>, Extent range <>) of Obstacle;
   --  all that counts in space is that you don't try to
   -- fly through rocks.
   -- the number of dimensions should be kept in sync with
   -- the instantiation of `Coordinate_System`

   pragma Pack(Known_Space);

   subtype Space_Section is Known_Space(Extent'first .. farthest_east_west,
                                        Extent'first .. farthest_north_south);


   --  The space map is available to the ships as a shared resource.
   --  If the map is declared to have a log, then any task may request
   --  a list of recently marked points.

   package Cartographic is

      type Discovery is record
         here: Space.Point;
         -- this `Point` has recently been discovered. (Or a ship could have
         -- discovered that the previous `Obstacle` is no longer there.
         -- This is not currently implemented.)

         marked: Obstacle;
         -- what kind of `Obstacle` the ship has found `here`

      end record;


      package Lists_of_Points is new AI302.Containers.Vectors
        (Element_Type => Discovery,
         Index_Type => Natural);


      type Discoveries is tagged record
         logged: Lists_of_Points.Vector;
         -- acts a lot like a queue

      end record;

   end Cartographic;


   protected type Map(logging_requested: Boolean) is

      --  An area is divided into small rectangles/cubes.  Note that a Map
      --  need not cover all known space, depending on the constraints on
      --  `Space_Section`


      procedure mark(here: Space.Point; item: Obstacle := Rock);

      function read(here: Space.Point) return Obstacle;

      procedure diff(result: out Cartographic.Discoveries);
      -- A copy of the list of `Point`s recently `mark`ed. The internal
      -- list is cleared.
      pragma Precondition(logging_requested);

   private
      grid: Space_Section;
      log: Cartographic.Lists_of_Points.Vector;
   end Map;



end Space_Info;

package body Space_Info is




   protected body Map is

      -- ----------------
      -- mark
      -- ----------------

      procedure mark(here: Space.Point; item: Obstacle := Rock) is
         use Cartographic.Lists_of_Points;
      begin
         grid(here(1), here(2)) := item;

         -- This line is reported:
         if logging_requested then append(log, (here, item)); end if;

         -- Qualifying the record removes the GNAT BUG BOX: 
         --if logging_requested then
         --    append(log, Cartographic.Discovery'(here, item));
         --end if;
      end mark;


      -- ----------------
      -- read
      -- ----------------

      function read(here: Space.Point) return Obstacle is
      begin
         return grid(here(1), here(2));
      end read;


      -- ----------------
      -- diff
      -- ----------------

      procedure diff(result: out Cartographic.Discoveries) is
         use Cartographic.Lists_of_Points;
      begin
         if not logging_requested then
            raise Program_Error;
         end if;

         result.logged := log;
         clear(log);
      end diff;

   end Map;



end Space_Info;
with Space_Info;

package Matter is

   package Our_World is new Space_Info(farthest_east_west => 3,
                                       farthest_north_south => 3);


   --  First the Unhidden_Obstacle map of our world.

   type Unhidden_Obstacle is (' ', 'X');
   type Space_String is array(Our_World.Extent'range) of Unhidden_Obstacle;
   type ASCII_Map is array(Our_World.Extent'range) of Space_String;

   quadrant: constant ASCII_Map :=
      ("  X",
       "XX ",
       "  X");


   --  Conversion functions to convert between external and internal
   --  representations of obstacles (or not) in space cubes.

   function to_Known_Space(x_map: ASCII_Map) return Our_World.Known_Space;

   function to_ASCII_Map(i_map: Our_World.Known_Space) return ASCII_Map;

   function to_Obstacle(c: Unhidden_Obstacle) return Our_World.Obstacle;

   function to_Unhidden_Obstacle(o: Our_World.Obstacle) return Unhidden_Obstacle;

end Matter;
generic
   type Coordinate is range <>;
   --  values of a coordinate

   Dim: Natural;
   --  number of dimensions that the corrdinate system is to have

package Coordinate_System is
   pragma Pure;
   
   type Dimensions is new Positive range 1 .. Dim;

   type Point is array (Dimensions) of Coordinate;
   

end Coordinate_System;
------------------------------------------------------------------------------
--                                                                          --
--                   AI-302 Reference Implementation                        --
--                                                                          --
--              Copyright (C) 2003-2004 Matthew J Heaney                    --
--                                                                          --
-- [...]
package AI302 is
   pragma Pure;
end AI302;

package AI302.Containers is
   pragma Pure (Containers);

   type Hash_Type is mod 2**32;
   type Count_Type is range 0 .. 2**31 - 1;

end AI302.Containers;

with Ada.Finalization;
with Ada.Streams;

generic

   type Index_Type is range <>;

   type Element_Type is private;

   with function "=" (Left, Right : Element_Type)
     return Boolean is <>;

package AI302.Containers.Vectors is
   pragma Preelaborate (Vectors);

   pragma Assert (Index_Type'Base'First < Index_Type'First);

   subtype Index_Subtype is Index_Type;

   type Vector is tagged private;

   type Cursor is private;

   function Empty_Vector return Vector;
   --  NOTE:
   --  The subcommittee report has this as a constant,
   --  but you can't do that without an Ada 0X compiler.
   --  For now I'll declare this as a function (which
   --  might be better anyway).

   No_Element : constant Cursor;

   function To_Vector (Count : Count_Type) return Vector;

   function To_Vector (New_Item : Element_Type;
                       Count    : Count_Type)
      return Vector;

   function "&" (Left, Right : Vector) return Vector;

   function "&" (Left  : Vector;
                 Right : Element_Type) return Vector;

   function "&" (Left  : Element_Type;
                 Right : Vector) return Vector;

   function "&" (Left, Right : Element_Type) return Vector;

   function "=" (Left, Right : Vector) return Boolean;

   function Capacity (Container : Vector) return Count_Type;

   procedure Set_Capacity (Container : in out Vector;
                           Capacity  : in     Count_Type);

   function Length (Container : Vector) return Count_Type;

   function Is_Empty (Container : Vector) return Boolean;

   procedure Clear (Container : in out Vector);

   function To_Cursor (Container : Vector;
                       Index     : Index_Type'Base)
      return Cursor;

   function To_Index (Position : Cursor) return Index_Type'Base;

   function Element (Container : Vector;
                     Index     : Index_Type'Base)
      return Element_Type;

   function Element (Position : Cursor) return Element_Type;

   generic
      with procedure Process (Element : in out Element_Type);
   procedure Generic_Update_Element_By_Index (Container : in Vector;
                                              Index     : in Index_Type'Base);

   generic
      with procedure Process (Element : in out Element_Type);
   procedure Generic_Update_Element (Position : in Cursor);

   procedure Replace_Element (Container : in Vector;
                              Index     : in Index_Type'Base;
                              By        : in Element_Type);

   procedure Replace_Element (Position : in Cursor;
                              By       : in Element_Type);

   procedure Assign (Target : in out Vector;
                     Source : in     Vector);

   procedure Move (Target : in out Vector;
                   Source : in out Vector);

   procedure Insert (Container : in out Vector;
                     Before    : in     Index_Type'Base;
                     New_Item  : in     Vector);

   procedure Insert (Container : in out Vector;
                     Before    : in     Cursor;
                     New_Item  : in     Vector);

   procedure Insert (Container : in out Vector;
                     Before    : in     Cursor;
                     New_Item  : in     Vector;
                     Position  :    out Cursor);

   procedure Insert (Container : in out Vector;
                     Before    : in     Index_Type'Base;
                     New_Item  : in     Element_Type;
                     Count     : in     Count_Type := 1);

   procedure Insert (Container : in out Vector;
                     Before    : in     Cursor;
                     New_Item  : in     Element_Type;
                     Count     : in     Count_Type := 1);

   procedure Insert (Container : in out Vector;
                     Before    : in     Cursor;
                     New_Item  : in     Element_Type;
                     Position  :    out Cursor;
                     Count     : in     Count_Type := 1);

   procedure Prepend (Container : in out Vector;
                      New_Item  : in     Vector);

   procedure Prepend (Container : in out Vector;
                      New_Item  : in     Element_Type;
                      Count     : in     Count_Type := 1);

   procedure Append (Container : in out Vector;
                     New_Item  : in     Vector);

   procedure Append (Container : in out Vector;
                     New_Item  : in     Element_Type;
                     Count     : in     Count_Type := 1);

   procedure Insert_Space (Container : in out Vector;
                           Before    : in     Index_Type'Base;
                           Count     : in     Count_Type := 1);

   procedure Insert_Space (Container : in out Vector;
                           Before    : in     Cursor;
                           Position  :    out Cursor;
                           Count     : in     Count_Type := 1);

   procedure Set_Length (Container : in out Vector;
                         Length    : in     Count_Type);

   procedure Delete (Container : in out Vector;
                     Index     : in     Index_Type'Base;
                     Count     : in     Count_Type := 1);

   procedure Delete (Container : in out Vector;
                     Position  : in out Cursor;
                     Count     : in     Count_Type := 1);

   procedure Delete_First (Container : in out Vector;
                           Count     : in     Count_Type := 1);

   procedure Delete_Last (Container : in out Vector;
                          Count     : in     Count_Type := 1);

   function First_Index (Container : Vector) return Index_Type;

   function First (Container : Vector) return Cursor;

   function First_Element (Container : Vector) return Element_Type;

   function Last_Index (Container : Vector) return Index_Type'Base;

   function Last (Container : Vector) return Cursor;

   function Last_Element (Container : Vector) return Element_Type;

   procedure Swap (Container : in Vector;
                   I, J      : in Index_Type'Base);

   procedure Swap (Container : in Vector;
                   I, J      : in Cursor);
   --  MJH:
   --  The inclusion of the Container parameter appears to be an error.
   --  ENDMJH.

   generic
      with function "<" (Left, Right : Element_Type) return Boolean is <>;
   procedure Generic_Sort (Container : in Vector);

   function Find (Container : Vector;
                  Item      : Element_Type;
                  Index     : Index_Type'Base := Index_Type'First)
      return Index_Type'Base;

   function Find (Container : Vector;
                  Item      : Element_Type;
                  Position  : Cursor := No_Element)
      return Cursor;

   function Reverse_Find (Container : Vector;
                          Item      : Element_Type;
                          Index     : Index_Type'Base := Index_Type'Last)
      return Index_Type'Base;

   function Reverse_Find (Container : Vector;
                          Item      : Element_Type;
                          Position  : Cursor := No_Element)
      return Cursor;

   function Is_In (Item      : Element_Type;
                   Container : Vector)
      return Boolean;
   --  MJH:
   --  I have left the parameters in this order, pending a ruling
   --  from the ARG.
   --  ENDMJH.

   function Next (Position : Cursor) return Cursor;

   function Previous (Position : Cursor) return Cursor;

   procedure Next (Position : in out Cursor);

   procedure Previous (Position : in out Cursor);

   function Has_Element (Position : Cursor) return Boolean;

   generic
      with procedure Process (Position : in Cursor);
   procedure Generic_Iteration (Container : in Vector);

   generic
      with procedure Process (Position : in Cursor);
   procedure Generic_Reverse_Iteration (Container : in Vector);

private
   type Elements_Type is array (Index_Type range <>) of Element_Type;

   function "=" (L, R : Elements_Type) return Boolean is abstract;

   type Elements_Access is access Elements_Type;

   use Ada.Finalization;

   subtype Last_Subtype is Index_Type'Base range
     Index_Type'Pred (Index_Type'First) .. Index_Type'Last;

   type Vector is new Controlled with record
      Elements : Elements_Access;
      Last     : Last_Subtype := Last_Subtype'First;
   end record;

   procedure Adjust (Container : in out Vector);

   procedure Finalize (Container : in out Vector);


   use Ada.Streams;

   procedure Write
     (Stream    : access Root_Stream_Type'Class;
      Container : in     Vector);

   for Vector'Write use Write;


   procedure Read
     (Stream    : access Root_Stream_Type'Class;
      Container :    out Vector);

   for Vector'Read use Read;


   type Vector_Constant_Access is access constant Vector;
   for Vector_Constant_Access'Storage_Size use 0;

   type Cursor is record
      Container : Vector_Constant_Access;
      Index     : Index_Type'Base := Index_Type'Pred (Index_Type'First);
   end record;

   No_Element : constant Cursor :=
     (Container => null,
      Index     => Index_Type'Pred (Index_Type'First));


end AI302.Containers.Vectors;

-- 
           Summary: GNAT BUG DETECTED, unqualified record aggregate triggers
           Product: gcc
           Version: 4.0.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P2
         Component: ada
        AssignedTo: unassigned at gcc dot gnu dot org
        ReportedBy: bauhaus at futureapps dot de
                CC: gcc-bugs at gcc dot gnu dot org
 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=19002