[Ada] Allow tighter packing for component with variant part

[Eric Botcazou <ebotcazou at adacore dot com>]

This lifts an old restriction pertaining to the layout of components of record 
types whose nominal subtype contains a variant part: they couldn't be packed.

Tested on x86_64-suse-linux, applied on the mainline.


2019-08-30  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/gigi.h (aggregate_type_contains_array_p): Declare.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: For an
	extension, test Has_Record_Rep_Clause instead of Has_Specified_Layout.
	(adjust_packed): Return 0 if the type of the field is an aggregate
	type that contains (or is) a self-referential array.
	(type_has_variable_size): Delete.
	* gcc-interface/utils.c (inish_record_type): Constify a variable.
	(aggregate_type_contains_array_p): Add parameter SELF_REFERENTIAL.
	<RECORD_TYPE>: Pass it in the recursive call.
	<ARRAY_TYPE>: If it is true, return true only if the array type is
	self-referential.
	(create_field_decl): Streamline the setting of the alignment on the
	field.  Pass false to aggregate_type_contains_array_p.


2019-08-30  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/pack24.adb: New test.

-- 
Eric Botcazou

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 275188)
+++ gcc-interface/decl.c	(working copy)
@@ -202,7 +202,6 @@ static void prepend_one_attribute_pragma (struct a
 static void prepend_attributes (struct attrib **, Entity_Id);
 static tree elaborate_expression (Node_Id, Entity_Id, const char *, bool, bool,
 				  bool);
-static bool type_has_variable_size (tree);
 static tree elaborate_expression_1 (tree, Entity_Id, const char *, bool, bool);
 static tree elaborate_expression_2 (tree, Entity_Id, const char *, bool, bool,
 				    unsigned int);
@@ -2953,10 +2952,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gn
 	      : 0;
 	const bool has_align = Known_Alignment (gnat_entity);
 	const bool has_discr = Has_Discriminants (gnat_entity);
-	const bool has_rep = Has_Specified_Layout (gnat_entity);
 	const bool is_extension
 	  = (Is_Tagged_Type (gnat_entity)
 	     && Nkind (record_definition) == N_Derived_Type_Definition);
+	const bool has_rep
+	  = is_extension
+	    ? Has_Record_Rep_Clause (gnat_entity)
+	    : Has_Specified_Layout (gnat_entity);
 	const bool is_unchecked_union = Is_Unchecked_Union (gnat_entity);
 	bool all_rep = has_rep;
 
@@ -6865,11 +6867,13 @@ choices_to_gnu (tree gnu_operand, Node_Id gnat_cho
 static int
 adjust_packed (tree field_type, tree record_type, int packed)
 {
-  /* If the field contains an item of variable size, we cannot pack it
-     because we cannot create temporaries of non-fixed size in case
-     we need to take the address of the field.  See addressable_p and
-     the notes on the addressability issues for further details.  */
-  if (type_has_variable_size (field_type))
+  /* If the field contains an array with self-referential size, we'd better
+     not pack it because this would misalign it and, therefore, cause large
+     temporaries to be created in case we need to take the address of the
+     field.  See addressable_p and the notes on the addressability issues
+     for further details.  */
+  if (AGGREGATE_TYPE_P (field_type)
+      && aggregate_type_contains_array_p (field_type, true))
     return 0;
 
   /* In the other cases, we can honor the packing.  */
@@ -7274,31 +7278,6 @@ components_need_strict_alignment (Node_Id componen
   return false;
 }
 
-/* Return true if TYPE is a type with variable size or a padding type with a
-   field of variable size or a record that has a field with such a type.  */
-
-static bool
-type_has_variable_size (tree type)
-{
-  tree field;
-
-  if (!TREE_CONSTANT (TYPE_SIZE (type)))
-    return true;
-
-  if (TYPE_IS_PADDING_P (type)
-      && !TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (type))))
-    return true;
-
-  if (!RECORD_OR_UNION_TYPE_P (type))
-    return false;
-
-  for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
-    if (type_has_variable_size (TREE_TYPE (field)))
-      return true;
-
-  return false;
-}
-
 /* Return true if FIELD is an artificial field.  */
 
 static bool
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h	(revision 275174)
+++ gcc-interface/gigi.h	(working copy)
@@ -835,6 +835,11 @@ extern tree get_base_type (tree type);
    in bits.  If we don't know anything about the alignment, return 0.  */
 extern unsigned int known_alignment (tree exp);
 
+/* Return true if TYPE, an aggregate type, contains (or is) an array.
+   If SELF_REFERENTIAL is true, then an additional requirement on the
+   array is that it be self-referential.  */
+extern bool aggregate_type_contains_array_p (tree type, bool self_referential);
+
 /* Return true if VALUE is a multiple of FACTOR. FACTOR must be a power
    of 2.  */
 extern bool value_factor_p (tree value, unsigned HOST_WIDE_INT factor);
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c	(revision 275190)
+++ gcc-interface/utils.c	(working copy)
@@ -1948,7 +1948,7 @@ finish_record_type (tree record_type, tree field_l
       if (DECL_BIT_FIELD (field)
 	  && operand_equal_p (this_size, TYPE_SIZE (type), 0))
 	{
-	  unsigned int align = TYPE_ALIGN (type);
+	  const unsigned int align = TYPE_ALIGN (type);
 
 	  /* In the general case, type alignment is required.  */
 	  if (value_factor_p (pos, align))
@@ -2764,10 +2764,12 @@ create_var_decl (tree name, tree asm_name, tree ty
   return var_decl;
 }
 
-/* Return true if TYPE, an aggregate type, contains (or is) an array.  */
+/* Return true if TYPE, an aggregate type, contains (or is) an array.
+   If SELF_REFERENTIAL is true, then an additional requirement on the
+   array is that it be self-referential.  */
 
-static bool
-aggregate_type_contains_array_p (tree type)
+bool
+aggregate_type_contains_array_p (tree type, bool self_referential)
 {
   switch (TREE_CODE (type))
     {
@@ -2778,13 +2780,14 @@ create_var_decl (tree name, tree asm_name, tree ty
 	tree field;
 	for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
 	  if (AGGREGATE_TYPE_P (TREE_TYPE (field))
-	      && aggregate_type_contains_array_p (TREE_TYPE (field)))
+	      && aggregate_type_contains_array_p (TREE_TYPE (field),
+						  self_referential))
 	    return true;
 	return false;
       }
 
     case ARRAY_TYPE:
-      return true;
+      return self_referential ? type_contains_placeholder_p (type) : true;
 
     default:
       gcc_unreachable ();
@@ -2808,18 +2811,6 @@ create_field_decl (tree name, tree type, tree reco
   DECL_CONTEXT (field_decl) = record_type;
   TREE_READONLY (field_decl) = TYPE_READONLY (type);
 
-  /* If FIELD_TYPE is BLKmode, we must ensure this is aligned to at least a
-     byte boundary since GCC cannot handle less-aligned BLKmode bitfields.
-     Likewise for an aggregate without specified position that contains an
-     array, because in this case slices of variable length of this array
-     must be handled by GCC and variable-sized objects need to be aligned
-     to at least a byte boundary.  */
-  if (packed && (TYPE_MODE (type) == BLKmode
-		 || (!pos
-		     && AGGREGATE_TYPE_P (type)
-		     && aggregate_type_contains_array_p (type))))
-    SET_DECL_ALIGN (field_decl, BITS_PER_UNIT);
-
   /* If a size is specified, use it.  Otherwise, if the record type is packed
      compute a size to use, which may differ from the object's natural size.
      We always set a size in this case to trigger the checks for bitfield
@@ -2872,23 +2863,39 @@ create_field_decl (tree name, tree type, tree reco
 
   DECL_PACKED (field_decl) = pos ? DECL_BIT_FIELD (field_decl) : packed;
 
+  /* If FIELD_TYPE is BLKmode, we must ensure this is aligned to at least a
+     byte boundary since GCC cannot handle less-aligned BLKmode bitfields.
+     Likewise for an aggregate without specified position that contains an
+     array, because in this case slices of variable length of this array
+     must be handled by GCC and variable-sized objects need to be aligned
+     to at least a byte boundary.  */
+  if (packed && (TYPE_MODE (type) == BLKmode
+		 || (!pos
+		     && AGGREGATE_TYPE_P (type)
+		     && aggregate_type_contains_array_p (type, false))))
+    SET_DECL_ALIGN (field_decl, BITS_PER_UNIT);
+
   /* Bump the alignment if need be, either for bitfield/packing purposes or
-     to satisfy the type requirements if no such consideration applies.  When
+     to satisfy the type requirements if no such considerations apply.  When
      we get the alignment from the type, indicate if this is from an explicit
      user request, which prevents stor-layout from lowering it later on.  */
-  {
-    unsigned int bit_align
-      = (DECL_BIT_FIELD (field_decl) ? 1
-	 : packed && TYPE_MODE (type) != BLKmode ? BITS_PER_UNIT : 0);
+  else
+    {
+      const unsigned int field_align
+	= DECL_BIT_FIELD (field_decl)
+	  ? 1
+	  : packed
+	    ? BITS_PER_UNIT
+	    : 0;
 
-    if (bit_align > DECL_ALIGN (field_decl))
-      SET_DECL_ALIGN (field_decl, bit_align);
-    else if (!bit_align && TYPE_ALIGN (type) > DECL_ALIGN (field_decl))
-      {
-	SET_DECL_ALIGN (field_decl, TYPE_ALIGN (type));
-	DECL_USER_ALIGN (field_decl) = TYPE_USER_ALIGN (type);
-      }
-  }
+      if (field_align > DECL_ALIGN (field_decl))
+	SET_DECL_ALIGN (field_decl, field_align);
+      else if (!field_align && TYPE_ALIGN (type) > DECL_ALIGN (field_decl))
+	{
+	  SET_DECL_ALIGN (field_decl, TYPE_ALIGN (type));
+	  DECL_USER_ALIGN (field_decl) = TYPE_USER_ALIGN (type);
+	}
+    }
 
   if (pos)
     {

--  { dg-do run }

with Interfaces;

procedure Pack24 is

   type Enum_1 is (Lit_1);
   for Enum_1'SIZE use 16;

   type Rec1(D1 : Enum_1 := Lit_1) is
      record
         case D1 is
         when Lit_1 =>
            F1 : Interfaces.Unsigned_16;
         when others =>
            Null;
         end case;
      end record;
   pragma Pack(Rec1);

   type Rec2 is
      record
         F1 : Interfaces.Unsigned_16;
         F2 : Rec1;
   end record;
   pragma Pack(Rec2);

   type Rec3 is record
      F1 : Interfaces.Unsigned_8;
      F2 : Rec2;
   end record;
   pragma Pack(Rec3);

begin
  if Rec3'Size /= 56 then
    raise Program_Error;
  end if;
end;