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/17160] Assert_Failure einfo.adb:1359


------- 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


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