This is the mail archive of the
gcc-bugs@gcc.gnu.org
mailing list for the GCC project.
[Bug ada/17160] Assert_Failure einfo.adb:1359
- From: "listor1 dot rombobeorn at comhem dot se" <gcc-bugzilla at gcc dot gnu dot org>
- To: gcc-bugs at gcc dot gnu dot org
- Date: 23 Sep 2004 20:40:02 -0000
- Subject: [Bug ada/17160] Assert_Failure einfo.adb:1359
- References: <20040824003813.17160.listor1.rombobeorn@comhem.se>
- Reply-to: gcc-bugzilla at gcc dot gnu dot org
------- 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