[Bug ada/17160] New: Assert_Failure einfo.adb:1359

[Bug ada/17160] New: Assert_Failure einfo.adb:1359

[listor1 dot rombobeorn at comhem dot se]

$ gcc -v
Reading specs from
/home/bjorn/ada/gcc-3.4.0-inst/lib/gcc/i686-pc-linux-gnu/3.4.0/specs
Configured with: /home/bjorn/ada/gcc-3.4.0/configure
--prefix=/home/bjorn/ada/gcc-3.4.0-inst
Thread model: posix
gcc version 3.4.0

$ gcc -c -I./ -I-
/home/bjorn/hemmaprogrammerat/adacl/Include/adacl-character_encodings.adb
+===========================GNAT BUG DETECTED==============================+
| 3.4.0 (i686-pc-linux-gnu) Assert_Failure einfo.adb:1359                  |
| Error detected at adacl-character_encodings.adb:61:14                    |
| 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).                   |
+==========================================================================+

-- 
           Summary: Assert_Failure einfo.adb:1359
           Product: gcc
           Version: 3.4.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P2
         Component: ada
        AssignedTo: unassigned at gcc dot gnu dot org
        ReportedBy: listor1 dot rombobeorn at comhem dot se
                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=17160

[Bug ada/17160] Assert_Failure einfo.adb:1359

[listor1 dot rombobeorn at comhem dot se]

------- Additional Comments From listor1 dot rombobeorn at comhem dot se  2004-08-24 00:40 -------
Created an attachment (id=6982)
 --> (http://gcc.gnu.org/bugzilla/attachment.cgi?id=6982&action=view)
source files


-- 


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

[Bug ada/17160] Assert_Failure einfo.adb:1359

[ludovic dot brenta at insalien dot org]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 415 bytes --]


------- Additional Comments From ludovic dot brenta at insalien dot org  2004-09-19 20:22 -------
Created an attachment (id=7175)
 --> (http://gcc.gnu.org/bugzilla/attachment.cgi?id=7175&action=view)
shorter test case

This shorter test case, from Björn Perssson the OP, also demonstrates the bug.
 Hopefully, it will make it easier to isolate the bug.

-- 


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

[Bug ada/17160] Assert_Failure einfo.adb:1359

[ludovic dot brenta at insalien dot org]

------- Additional Comments From ludovic dot brenta at insalien dot org  2004-09-19 20:23 -------
This bug is not present in GNAT 3.15p-12 on Debian GNU/Linux, but it is in 3.4.2-2.


-- 


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

[Bug ada/17160] Assert_Failure einfo.adb:1359

[listor1 dot rombobeorn at comhem dot se]

------- Additional Comments From listor1 dot rombobeorn at comhem dot se  2004-09-23 20:39 -------
Subject: Re:  Assert_Failure einfo.adb:1359

The attached file uninitialized_field.adb demonstrates a case where the 
discriminant "OS" isn't initialized. I compile and run it like this:

$ gnatmake uninitialized_field.adb
gcc -c uninitialized_field.adb
gnatbind -x uninitialized_field.ali
gnatlink uninitialized_field.ali
$ ./uninitialized_field
Initialized with Unified_Encoding_Record aggregate:
With predefined "=" - A1a and A2a: equal
Initialized with Character_Encoding aggregate:
With predefined "=" - A1b and A2b: not equal
With redefined "=" - B1c and B2c: equal
OS of A1a: LINUX
OS of A2a: LINUX
OS of A1b: OS2
OS of A2b:

raised CONSTRAINT_ERROR : uninitialized_field.adb:117 invalid data

Correct output would be:

Initialized with Unified_Encoding_Record aggregate:
With predefined "=" - A1a and A2a: equal
Initialized with Character_Encoding aggregate:
With predefined "=" - A1b and A2b: equal
With redefined "=" - B1c and B2c: equal
OS of A1a: LINUX
OS of A2a: LINUX
OS of A1b: LINUX
OS of A2b: LINUX

The other attached file, convert_to_pointer.ada, contains relevant parts 
of the code in uninitialized_field.adb, but here the declarations are in 
a package and are referenced from the main program. This causes a very 
strange error message:

$ gnatmake convert_to_pointer_package.ads
gcc -c convert_to_pointer_package.ads
$ LANG=en_US gnatmake convert_to_pointer_main.adb
gcc -c convert_to_pointer_main.adb
convert_to_pointer_package.ads: In function `Convert_To_Pointer_Main':
convert_to_pointer_package.ads:37: error: cannot convert to a pointer type
gnatmake: "convert_to_pointer_main.adb" compilation error

This is with GCC-Gnat 3.4.0 on Gnu/Linux (Fedora Core 1).
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Interfaces; use Interfaces;

procedure Uninitialized_Field is

   type Known_OS is (NT, OS2, Linux);

   This_OS : constant Known_OS := Linux;

   type Encoding_ID is
     (UTF_8_ID, ASCII_ID, Latin_1_ID);

   type Unified_Encoding_Record (Known : Boolean; OS : Known_OS) is record
      case Known is
         when True =>
            Which : Encoding_ID;
         when False =>
            case OS is
               when Linux =>
                  -- If Unbounded_String is replaced with Character,
                  -- the problem goes away.
                  Name : Unbounded_String;
               when NT | OS2 =>
                  Number : Unsigned_16;
            end case;
      end case;
   end record;

   -- Two identical types are defined and "=" is overridden for one of them
   -- to compare the predefined "=" to this one.

   type Character_Encoding_A (Known : Boolean := False) is
     new Unified_Encoding_Record (Known => Known, OS => This_OS);

   type Character_Encoding_B (Known : Boolean := False) is
     new Unified_Encoding_Record (Known => Known, OS => This_OS);

   function "=" (Left, Right : Character_Encoding_B) return Boolean is
   begin
      if Left.Known /= Right.Known then
         return False;
      elsif Left.Known then
         return Left.Which = Right.Which;
      else
         case This_OS is
            when Linux =>
               return Left.Name = Right.Name;
            when NT | OS2 =>
               return Left.Number = Right.Number;
         end case;
      end if;
   end "=";

   type Encoding_Bytes is
     array (1 .. Unified_Encoding_Record'Size / 8)
     of aliased Unsigned_8;
   for Encoding_Bytes'Component_Size use 8;

   -- The Raw constants and the address clauses are here solely to get control
   -- over what is in the memory cells before the Encoding constants are
   -- created. Without them the bug would not get reproduced reliably.

   Raw_1a : constant Encoding_Bytes := (others => 1);
   Raw_1b : constant Encoding_Bytes := (others => 1);
   Raw_1c : constant Encoding_Bytes := (others => 1);
   Raw_2a : constant Encoding_Bytes := (others => 3);
   Raw_2b : constant Encoding_Bytes := (others => 3);
   Raw_2c : constant Encoding_Bytes := (others => 3);

   -- When the constants are initialized like this, everything is OK:

   Encoding_A1a : constant Character_Encoding_A := Character_Encoding_A
     (Unified_Encoding_Record'(True, This_OS, Latin_1_ID));
   Encoding_A2a : constant Character_Encoding_A := Character_Encoding_A
     (Unified_Encoding_Record'(True, This_OS, Latin_1_ID));

   -- When it's done this way, the OS field isn't initialized:

   Encoding_A1b : constant Character_Encoding_A := (True, Latin_1_ID);
   Encoding_A2b : constant Character_Encoding_A := (True, Latin_1_ID);
   Encoding_B1c : constant Character_Encoding_B := (True, Latin_1_ID);
   Encoding_B2c : constant Character_Encoding_B := (True, Latin_1_ID);

   for Encoding_A1a'Address use Raw_1a'Address;
   for Encoding_A2a'Address use Raw_2a'Address;
   for Encoding_A1b'Address use Raw_1b'Address;
   for Encoding_A2b'Address use Raw_2b'Address;
   for Encoding_B1c'Address use Raw_1c'Address;
   for Encoding_B2c'Address use Raw_2c'Address;

   procedure Show (Equal : Boolean) is
   begin
      if Equal then
         Put_Line ("equal");
      else
         Put_Line ("not equal");
      end if;
   end Show;

begin
   Put_Line ("Initialized with Unified_Encoding_Record aggregate: ");
   Put ("With predefined ""="" - A1a and A2a: ");
   Show (Encoding_A1a = Encoding_A2a);  -- equal
   Put_Line ("Initialized with Character_Encoding aggregate: ");
   Put ("With predefined ""="" - A1b and A2b: ");
   Show (Encoding_A1b = Encoding_A2b);  -- not equal, WRONG
   Put ("With redefined ""="" - B1c and B2c: ");
   Show (Encoding_B1c = Encoding_B2c);  -- equal
   Put ("OS of A1a: ");  -- Linux
   Put_Line (Known_OS'Image (Unified_Encoding_Record (Encoding_A1a).OS));
   Put ("OS of A2a: ");  -- Linux
   Put_Line (Known_OS'Image (Unified_Encoding_Record (Encoding_A2a).OS));
   Put ("OS of A1b: ");  -- OS2, WRONG
   Put_Line (Known_OS'Image (Unified_Encoding_Record (Encoding_A1b).OS));
   Put ("OS of A2b: ");  -- invalid data
   Put_Line (Known_OS'Image (Unified_Encoding_Record (Encoding_A2b).OS));
end Uninitialized_Field;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Interfaces; use Interfaces;

package Convert_To_Pointer_Package is

   type Known_OS is (NT, OS2, Linux);

   This_OS : constant Known_OS := Linux;

   type Encoding_ID is
     (UTF_8_ID, ASCII_ID, Latin_1_ID);

   type Unified_Encoding_Record (Known : Boolean; OS : Known_OS) is record
      case Known is
         when True =>
            Which : Encoding_ID;
         when False =>
            case OS is
               when Linux =>
                  Name : Unbounded_String;
               when NT | OS2 =>
                  Number : Unsigned_16;
            end case;
      end case;
   end record;

   type Character_Encoding_A (Known : Boolean := False) is
     new Unified_Encoding_Record (Known => Known, OS => This_OS);

   type Encoding_Bytes is
     array (1 .. Unified_Encoding_Record'Size / 8)
     of aliased Unsigned_8;
   for Encoding_Bytes'Component_Size use 8;

   Raw_1a : constant Encoding_Bytes := (others => 1);
   Encoding_A1a : constant Character_Encoding_A := Character_Encoding_A
     (Unified_Encoding_Record'(True, This_OS, Latin_1_ID));
   for Encoding_A1a'Address use Raw_1a'Address;

end Convert_To_Pointer_Package;
with Convert_To_Pointer_Package; use Convert_To_Pointer_Package;

procedure Convert_To_Pointer_Main is
begin
   if Encoding_A1a.Known then
      null;
   end if;
end Convert_To_Pointer_Main;


-- 


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

[Bug ada/17160] Assert_Failure einfo.adb:1359

[listor1 dot rombobeorn at comhem dot se]

------- Additional Comments From listor1 dot rombobeorn at comhem dot se  2004-09-23 21:04 -------
Subject: Re:  Assert_Failure einfo.adb:1359

Sorry about the "Content-Disposition: inline;". I told Mozilla to 
*attach* the files, so I did expect them to be *attachments*.



-- 


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

[Bug ada/17160] Assert_Failure einfo.adb:1359

[listor1 dot rombobeorn at comhem dot se]

------- Additional Comments From listor1 dot rombobeorn at comhem dot se  2004-09-23 21:07 -------
Created an attachment (id=7206)
 --> (http://gcc.gnu.org/bugzilla/attachment.cgi?id=7206&action=view)
demonstrates uninitialized discriminant


-- 


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

[Bug ada/17160] Assert_Failure einfo.adb:1359

[listor1 dot rombobeorn at comhem dot se]

------- Additional Comments From listor1 dot rombobeorn at comhem dot se  2004-09-23 21:09 -------
Created an attachment (id=7207)
 --> (http://gcc.gnu.org/bugzilla/attachment.cgi?id=7207&action=view)
demonstrates strange error message


-- 


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

[Bug ada/17160] Assert_Failure einfo.adb:1359

[pinskia at gcc dot gnu dot org]

------- Additional Comments From pinskia at gcc dot gnu dot org  2004-10-12 03:46 -------
Fixed on the mainline.

-- 
           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|UNCONFIRMED                 |RESOLVED
           Keywords|                            |ice-on-valid-code
         Resolution|                            |FIXED
   Target Milestone|---                         |4.0.0


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