[Ada] Fix inconsistent Value_Size for Strict_Alignment types

Message ID 9526085.TaSYqGNSro@polaris
State New
Headers show
Series
  • [Ada] Fix inconsistent Value_Size for Strict_Alignment types
Related show

Commit Message

Eric Botcazou June 29, 2019, 8:10 a.m.
In Ada we have what we call strict-alignment types, i.e. types that can never 
be misaligned in record types.  They are exactly the types which contain an 
aliased field, either explicitly or implicitly (i.e. tagged types).

For them, by definition of 'Size in the Ada RM, this 'Size must be equal to 
the natural size, which means that 'Value_Size = 'Object_Size for GNAT.

Tested on x86-64/Linux, applied on mainline.


2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: If the
	type requires strict alignment, then set the RM size to the type size.
	Rework handling of alignment and sizes of tagged types in ASIS mode.
	(validate_size): Rename local variable and remove special handling for
	strict-alignment types.
	* gcc-interface/utils.c (finish_record_type): Constify local variables
	and use properly typed constants.


2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/specs/size_clause3.ads: Adjust error message.

-- 
Eric Botcazou

Patch

Index: ada/gcc-interface/decl.c
===================================================================
--- ada/gcc-interface/decl.c	(revision 272819)
+++ ada/gcc-interface/decl.c	(working copy)
@@ -3004,9 +3004,9 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	  {
 	    SET_TYPE_ALIGN (gnu_type, 0);
 
-	    /* If a type needs strict alignment, the minimum size will be the
-	       type size instead of the RM size (see validate_size).  Cap the
-	       alignment lest it causes this type size to become too large.  */
+	    /* If a type needs strict alignment, then its type size will also
+	       be the RM size (see below).  Cap the alignment if needed, lest
+	       it may cause this type size to become too large.  */
 	    if (Strict_Alignment (gnat_entity) && Known_RM_Size (gnat_entity))
 	      {
 		unsigned int max_size = UI_To_Int (RM_Size (gnat_entity));
@@ -3283,6 +3283,12 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 		compute_record_mode (gnu_type);
 	      }
 
+	    /* If the type needs strict alignment, then no object of the type
+	       may have a size smaller than the natural size, which means that
+	       the RM size of the type is equal to the type size.  */
+	    if (Strict_Alignment (gnat_entity))
+	      SET_TYPE_ADA_SIZE (gnu_type, TYPE_SIZE (gnu_type));
+
 	    /* If there are entities in the chain corresponding to components
 	       that we did not elaborate, ensure we elaborate their types if
 	       they are Itypes.  */
@@ -4187,7 +4193,10 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	 already defined so we cannot pass true for IN_PLACE here.  */
       process_attributes (&gnu_type, &attr_list, false, gnat_entity);
 
-      /* ??? Don't set the size for a String_Literal since it is either
+      /* See if a size was specified, by means of either an Object_Size or
+         a regular Size clause, and validate it if so.
+
+	 ??? Don't set the size for a String_Literal since it is either
 	 confirming or we don't handle it properly (if the low bound is
 	 non-constant).  */
       if (!gnu_size && kind != E_String_Literal_Subtype)
@@ -4309,49 +4318,44 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 
 	  /* If we are just annotating types and the type is tagged, the tag
 	     and the parent components are not generated by the front-end so
-	     alignment and sizes must be adjusted if there is no rep clause.  */
-	  if (type_annotate_only
-	      && Is_Tagged_Type (gnat_entity)
-	      && Unknown_RM_Size (gnat_entity)
-	      && !VOID_TYPE_P (gnu_type)
-	      && (!TYPE_FIELDS (gnu_type)
-		  || integer_zerop (bit_position (TYPE_FIELDS (gnu_type)))))
+	     alignment and sizes must be adjusted.  */
+	  if (type_annotate_only && Is_Tagged_Type (gnat_entity))
 	    {
-	      tree offset;
-
-	      if (Is_Derived_Type (gnat_entity))
+	      const bool derived_p = Is_Derived_Type (gnat_entity);
+	      const Entity_Id gnat_parent
+		= derived_p ? Etype (Base_Type (gnat_entity)) : Empty;
+	      const unsigned int inherited_align
+		= derived_p
+		  ? UI_To_Int (Alignment (gnat_parent)) * BITS_PER_UNIT
+		  : POINTER_SIZE;
+	      const unsigned int align
+		= MAX (TYPE_ALIGN (gnu_type), inherited_align);
+
+	      Set_Alignment (gnat_entity, UI_From_Int (align / BITS_PER_UNIT));
+
+	      /* If there is neither size clause nor representation clause, the
+		 sizes need to be adjusted.  */
+	      if (Unknown_RM_Size (gnat_entity)
+		  && !VOID_TYPE_P (gnu_type)
+		  && (!TYPE_FIELDS (gnu_type)
+		      || integer_zerop (bit_position (TYPE_FIELDS (gnu_type)))))
 		{
-		  Entity_Id gnat_parent = Etype (Base_Type (gnat_entity));
-		  offset = UI_To_gnu (Esize (gnat_parent), bitsizetype);
-		  Set_Alignment (gnat_entity, Alignment (gnat_parent));
+		  tree offset
+		    = derived_p
+		      ? UI_To_gnu (Esize (gnat_parent), bitsizetype)
+		      : bitsize_int (POINTER_SIZE);
+		  if (TYPE_FIELDS (gnu_type))
+		    offset
+		      = round_up (offset, DECL_ALIGN (TYPE_FIELDS (gnu_type)));
+		  gnu_size = size_binop (PLUS_EXPR, gnu_size, offset);
 		}
-	      else
-		{
-		  unsigned int align
-		    = MAX (TYPE_ALIGN (gnu_type), POINTER_SIZE) / BITS_PER_UNIT;
-		  offset = bitsize_int (POINTER_SIZE);
-		  Set_Alignment (gnat_entity, UI_From_Int (align));
-		}
-
-	      if (TYPE_FIELDS (gnu_type))
-		offset
-		  = round_up (offset, DECL_ALIGN (TYPE_FIELDS (gnu_type)));
-
-	      gnu_size = size_binop (PLUS_EXPR, gnu_size, offset);
-	      gnu_size = round_up (gnu_size, POINTER_SIZE);
-	      Uint uint_size = annotate_value (gnu_size);
-	      Set_RM_Size (gnat_entity, uint_size);
-	      Set_Esize (gnat_entity, uint_size);
-	    }
 
-	  /* If there is a rep clause, only adjust alignment and Esize.  */
-	  else if (type_annotate_only && Is_Tagged_Type (gnat_entity))
-	    {
-	      unsigned int align
-		= MAX (TYPE_ALIGN (gnu_type), POINTER_SIZE) / BITS_PER_UNIT;
-	      Set_Alignment (gnat_entity, UI_From_Int (align));
-	      gnu_size = round_up (gnu_size, POINTER_SIZE);
+	      gnu_size = round_up (gnu_size, align);
 	      Set_Esize (gnat_entity, annotate_value (gnu_size));
+
+	      /* Tagged types are Strict_Alignment so RM_Size = Esize.  */
+	      if (Unknown_RM_Size (gnat_entity))
+		Set_RM_Size (gnat_entity, Esize (gnat_entity));
 	    }
 
 	  /* Otherwise no adjustment is needed.  */
@@ -8732,7 +8736,7 @@  validate_size (Uint uint_size, tree gnu_
 	       enum tree_code kind, bool component_p, bool zero_ok)
 {
   Node_Id gnat_error_node;
-  tree type_size, size;
+  tree old_size, size;
 
   /* Return 0 if no size was specified.  */
   if (uint_size == No_Uint)
@@ -8797,17 +8801,11 @@  validate_size (Uint uint_size, tree gnu_
       && TYPE_CONTAINS_TEMPLATE_P (gnu_type))
     size = size_binop (PLUS_EXPR, DECL_SIZE (TYPE_FIELDS (gnu_type)), size);
 
-  if (kind == VAR_DECL
-      /* If a type needs strict alignment, a component of this type in
-	 a packed record cannot be packed and thus uses the type size.  */
-      || (kind == TYPE_DECL && Strict_Alignment (gnat_object)))
-    type_size = TYPE_SIZE (gnu_type);
-  else
-    type_size = rm_size (gnu_type);
+  old_size = (kind == VAR_DECL ? TYPE_SIZE (gnu_type) : rm_size (gnu_type));
 
-  /* Modify the size of a discriminated type to be the maximum size.  */
-  if (type_size && CONTAINS_PLACEHOLDER_P (type_size))
-    type_size = max_size (type_size, true);
+  /* If the old size is self-referential, get the maximum size.  */
+  if (CONTAINS_PLACEHOLDER_P (old_size))
+    old_size = max_size (old_size, true);
 
   /* If this is an access type or a fat pointer, the minimum size is that given
      by the smallest integral mode that's valid for pointers.  */
@@ -8816,23 +8814,23 @@  validate_size (Uint uint_size, tree gnu_
       scalar_int_mode p_mode = NARROWEST_INT_MODE;
       while (!targetm.valid_pointer_mode (p_mode))
 	p_mode = GET_MODE_WIDER_MODE (p_mode).require ();
-      type_size = bitsize_int (GET_MODE_BITSIZE (p_mode));
+      old_size = bitsize_int (GET_MODE_BITSIZE (p_mode));
     }
 
   /* Issue an error either if the default size of the object isn't a constant
      or if the new size is smaller than it.  */
-  if (TREE_CODE (type_size) != INTEGER_CST
-      || TREE_OVERFLOW (type_size)
-      || tree_int_cst_lt (size, type_size))
+  if (TREE_CODE (old_size) != INTEGER_CST
+      || TREE_OVERFLOW (old_size)
+      || tree_int_cst_lt (size, old_size))
     {
       if (component_p)
 	post_error_ne_tree
 	  ("component size for& too small{, minimum allowed is ^}",
-	   gnat_error_node, gnat_object, type_size);
+	   gnat_error_node, gnat_object, old_size);
       else
 	post_error_ne_tree
 	  ("size for& too small{, minimum allowed is ^}",
-	   gnat_error_node, gnat_object, type_size);
+	   gnat_error_node, gnat_object, old_size);
       return NULL_TREE;
     }
 
Index: ada/gcc-interface/utils.c
===================================================================
--- ada/gcc-interface/utils.c	(revision 272810)
+++ ada/gcc-interface/utils.c	(working copy)
@@ -1859,13 +1859,18 @@  void
 finish_record_type (tree record_type, tree field_list, int rep_level,
 		    bool debug_info_p)
 {
-  enum tree_code code = TREE_CODE (record_type);
+  const enum tree_code orig_code = TREE_CODE (record_type);
+  const bool had_size = TYPE_SIZE (record_type) != NULL_TREE;
+  const bool had_size_unit = TYPE_SIZE_UNIT (record_type) != NULL_TREE;
+  const bool had_align = TYPE_ALIGN (record_type) > 0;
+  /* For all-repped records with a size specified, lay the QUAL_UNION_TYPE
+     out just like a UNION_TYPE, since the size will be fixed.  */
+  const enum tree_code code
+    = (orig_code == QUAL_UNION_TYPE && rep_level > 0 && had_size
+       ? UNION_TYPE : orig_code);
   tree name = TYPE_IDENTIFIER (record_type);
   tree ada_size = bitsize_zero_node;
   tree size = bitsize_zero_node;
-  bool had_size = TYPE_SIZE (record_type) != 0;
-  bool had_size_unit = TYPE_SIZE_UNIT (record_type) != 0;
-  bool had_align = TYPE_ALIGN (record_type) != 0;
   tree field;
 
   TYPE_FIELDS (record_type) = field_list;
@@ -1878,26 +1883,21 @@  finish_record_type (tree record_type, tr
      that just means some initializations; otherwise, layout the record.  */
   if (rep_level > 0)
     {
-      SET_TYPE_ALIGN (record_type, MAX (BITS_PER_UNIT,
-					TYPE_ALIGN (record_type)));
-
-      if (!had_size_unit)
-	TYPE_SIZE_UNIT (record_type) = size_zero_node;
+      if (TYPE_ALIGN (record_type) < BITS_PER_UNIT)
+	SET_TYPE_ALIGN (record_type, BITS_PER_UNIT);
 
       if (!had_size)
 	TYPE_SIZE (record_type) = bitsize_zero_node;
 
-      /* For all-repped records with a size specified, lay the QUAL_UNION_TYPE
-	 out just like a UNION_TYPE, since the size will be fixed.  */
-      else if (code == QUAL_UNION_TYPE)
-	code = UNION_TYPE;
+      if (!had_size_unit)
+	TYPE_SIZE_UNIT (record_type) = size_zero_node;
     }
   else
     {
       /* Ensure there isn't a size already set.  There can be in an error
 	 case where there is a rep clause but all fields have errors and
 	 no longer have a position.  */
-      TYPE_SIZE (record_type) = 0;
+      TYPE_SIZE (record_type) = NULL_TREE;
 
       /* Ensure we use the traditional GCC layout for bitfields when we need
 	 to pack the record type or have a representation clause.  The other
Index: testsuite/gnat.dg/specs/size_clause3.ads
===================================================================
--- testsuite/gnat.dg/specs/size_clause3.ads	(revision 272819)
+++ testsuite/gnat.dg/specs/size_clause3.ads	(working copy)
@@ -14,7 +14,7 @@  package Size_Clause3 is
     rr : R1; -- size must be 40
   end record;
   for S1 use record
-    rr at 0 range 0 .. 39;  -- { dg-error "size for .rr. with aliased or tagged" }
+    rr at 0 range 0 .. 39;  -- { dg-error "size for .rr. too small" }
   end record;
 
   -- The record is explicitly given alignment 1 so its real type is 40.
@@ -44,7 +44,7 @@  package Size_Clause3 is
     rr : R3; -- size must be 40
   end record;
   for S3 use record
-    rr at 0 range 0 .. 39;  -- { dg-error "size for .rr. with aliased or tagged" }
+    rr at 0 range 0 .. 39;  -- { dg-error "size for .rr. too small" }
   end record;
 
 end Size_Clause3;