[Ada] Crash on constant declaration with variable size with generics

Arnaud Charlet charlet@adacore.com
Wed Jan 22 16:43:00 GMT 2014

This change fixes a compiler crash occurring in some cases of constant
declarations initialized with a call to an instance of a generic function,
when the returned type is an array of dynamically sized elements.

The following compilation must be accepted quietly:

$ gcc -c p.adb
package Q is
   function F return Integer;
   subtype Comp is String (1 .. F);
   type Element_T is record
      C : Comp;
   end record;
end Q;

with Q;
procedure P is
   type Exist_Element_T (Exist : Boolean := False) is record
      case Exist is
         when True => Value : Q.Element_T;
         when False => null;
      end case;
   end record;

   type Arr is array (Boolean) of Exist_Element_T;

      type Idx is (<>);
      type Elmt is private;
      type Arr is array (Idx) of Elmt;
   function F_G return Arr;

   function F_G return Arr is
      A : Elmt;
      return Arr'(others => A);
   end F_G;

   function F is new F_G (Idx => Boolean, Elmt => Exist_Element_T, Arr => Arr);

   Const_Arr : constant Arr := F;


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

2014-01-22  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb (Analyze_Object_Declaration): For a constant
	declaration initialized with a function call, whose type
	has variable size, need to remove side effects so that the
	initialization expression becomes a dereference of a temporary
	reference to the function result.

-------------- next part --------------
Index: sem_ch3.adb
--- sem_ch3.adb	(revision 206923)
+++ sem_ch3.adb	(working copy)
@@ -2991,6 +2991,11 @@
       --  or a variant record type is encountered, Check_Restrictions is called
       --  indicating the count is unknown.
+      function Has_Unconstrained_Elements (T : Entity_Id) return Boolean;
+      --  True if T has discriminants and is unconstrained, or is an array
+      --  type whose element type Has_Unconstrained_Elements. Shouldn't this
+      --  be in sem_util???
       -- Count_Tasks --
@@ -3045,6 +3050,24 @@
          end if;
       end Count_Tasks;
+      --------------------------------
+      -- Has_Unconstrained_Elements --
+      --------------------------------
+      function Has_Unconstrained_Elements (T : Entity_Id) return Boolean is
+         U_T : constant Entity_Id := Underlying_Type (T);
+      begin
+         if No (U_T) then
+            return False;
+         elsif Is_Record_Type (U_T) then
+            return Has_Discriminants (U_T) and then not Is_Constrained (U_T);
+         elsif Is_Array_Type (U_T) then
+            return Has_Unconstrained_Elements (Component_Type (U_T));
+         else
+            return False;
+         end if;
+      end Has_Unconstrained_Elements;
    --  Start of processing for Analyze_Object_Declaration
@@ -3647,16 +3670,15 @@
          Rewrite (Object_Definition (N), New_Occurrence_Of (Act_T, Loc));
-      elsif Present (Underlying_Type (T))
-        and then not Is_Constrained (Underlying_Type (T))
-        and then Has_Discriminants (Underlying_Type (T))
-        and then Nkind (E) = N_Function_Call
+      elsif Nkind (E) = N_Function_Call
         and then Constant_Present (N)
+        and then Has_Unconstrained_Elements (Etype (E))
          --  The back-end has problems with constants of a discriminated type
          --  with defaults, if the initial value is a function call. We
-         --  generate an intermediate temporary for the result of the call.
-         --  It is unclear why this should make it acceptable to gcc. ???
+         --  generate an intermediate temporary that will receive a reference
+         --  to the result of the call. The initialization expression then
+         --  becomes a dereference of that temporary.
          Remove_Side_Effects (E);

More information about the Gcc-patches mailing list