[Ada] Crash on unconstrained unchecked union declaration

[Arnaud Charlet]

When an object declaration as an indefinite type, the actual subtype of the
object is constructed from the expression itself. If the type is an unchecked
union such a subtype cannot be constructed because discriminants cannot be
retrieved from the expression. In this case, rewrite declaration as a renaming
declaration, where the back-end does not require a definite subtype.

Compiling and executing foo.adb must yield::


   TRUE
   FALSE
   TRUE
   'A'
    11
    100

---
with Text_IO; use Text_IO;
procedure Foo is
   type Rec_Type (I : Integer ) is record
      B : Boolean;
      case I is
         when 0 =>
            null;
         when 1 .. 10 =>
            C : Character;
         when others =>
            N : Natural;
      end case;
   end record;
   pragma Unchecked_Union (Rec_Type);

   function Get (I : Integer) return Rec_Type is
   begin
     case I is
        when 0       =>  return (I => 0, B => True);
        when 1 .. 10 =>  return (I => 1, B => False, C => 'A');
        when others  =>  return (I => 11, B => True, N => abs I);
     end case;
   end Get;

   procedure Nop (R : Rec_Type) is
   begin
      Put_Line (Boolean'Image (R.B));
   end Nop;

   R0 : constant Rec_Type  := Get (0);
   R1 : constant Rec_Type  := Get (1);
   R11 : constant Rec_Type  := Get (11);
   R100 : Rec_Type := Get (100);

begin
   Nop (R0);
   Nop (R1);
   Nop (R11);
   Put_Line (Character'Image (R1.C));
   Put_Line (Integer'Image (R11.N));
   Put_Line (Integer'Image (R100.N));
end Foo;

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-10-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Analyze_Object_Declaration): If the type is
	an unconstrained unchecked_union type, rewrite declaration
	as a renaming to prevent attempt to retrieve non- existent
	discriminants from expression.

-------------- next part --------------
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 216476)
+++ sem_ch3.adb	(working copy)
@@ -3839,6 +3839,32 @@
             elsif GNATprove_Mode then
                null;
 
+            --  If the type is an unchecked union, no subtype can be built from
+            --  the expression. Rewrite declaration as a renaming, which the
+            --  back-end can handle properly. This is a rather unusual case,
+            --  because most unchecked_union declarations have default values
+            --  for discriminants and are thus unconstrained.
+
+            elsif Is_Unchecked_Union (T) then
+               if Constant_Present (N)
+                 or else Nkind (E) = N_Function_Call
+               then
+                  Set_Ekind (Id, E_Constant);
+               else
+                  Set_Ekind (Id, E_Variable);
+               end if;
+
+               Rewrite (N,
+                 Make_Object_Renaming_Declaration (Loc,
+                    Defining_Identifier => Id,
+                    Subtype_Mark => New_Occurrence_Of (T, Loc),
+                    Name => E));
+
+               Set_Renamed_Object (Id, E);
+               Freeze_Before (N, T);
+               Set_Is_Frozen (Id);
+               return;
+
             else
                Expand_Subtype_From_Expr (N, T, Object_Definition (N), E);
                Act_T := Find_Type_Of_Object (Object_Definition (N), N);