decl.c (gnat_to_gnu_entity): If the type requires strict alignment, then set the...
authorEric Botcazou <ebotcazou@adacore.com>
Sat, 29 Jun 2019 08:10:20 +0000 (08:10 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Sat, 29 Jun 2019 08:10:20 +0000 (08:10 +0000)
* 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.

From-SVN: r272820

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/utils.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/specs/size_clause3.ads

index 31805e545e88880f7592070297fffa724d2b8997..157ca3684d001ef2022b8e0d0e27f4a05c5b54c4 100644 (file)
@@ -1,3 +1,13 @@
+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>
 
        * gcc-interface/decl.c (gnat_to_gnu_field): Rework error messages for
index 6d7900d000da353a6038b8b6fac4a897ea96a7d2..e99aeb4ad0f26767f48dbac82de58e7153d924fe 100644 (file)
@@ -3004,9 +3004,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
          {
            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_entity, tree gnu_expr, bool definition)
                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_entity, tree gnu_expr, bool definition)
         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_entity, tree gnu_expr, bool definition)
 
          /* 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))
-               {
-                 Entity_Id gnat_parent = Etype (Base_Type (gnat_entity));
-                 offset = UI_To_gnu (Esize (gnat_parent), bitsizetype);
-                 Set_Alignment (gnat_entity, Alignment (gnat_parent));
-               }
-             else
+             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)))))
                {
-                 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));
+                 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);
                }
 
-             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_type, Entity_Id gnat_object,
               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, Entity_Id gnat_object,
       && 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_type, Entity_Id gnat_object,
       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 c4842b2e72097dc10ba0079ab47ebc7e910f4cba..9da606e1494d13c93e2b051d4ed3b3f0088437f8 100644 (file)
@@ -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, tree field_list, int rep_level,
      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 679f1da4b6e27abcf78f9eebcf02402b73a1b06b..d2d59903dd3e5fd1b865a24b6f5f2295e29e7c68 100644 (file)
@@ -1,3 +1,7 @@
+2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/specs/size_clause3.ads: Adjust error message.
+
 2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/specs/atomic2.ads: Adjust error message.
index fd7999a1c551b7f372e4e8c06db77b0b18f36ec1..12ca2d1aba6e8432b080dcd8367e4b80fac23531 100644 (file)
@@ -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;