[Ada] Fix -gnatR3 output for dynamically constrained record
authorEric Botcazou <ebotcazou@adacore.com>
Tue, 11 Dec 2018 11:11:47 +0000 (11:11 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Tue, 11 Dec 2018 11:11:47 +0000 (11:11 +0000)
2018-12-11  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

* gcc-interface/decl.c (gnat_to_gnu_entity): Add
gnat_annotate_type local variable initialized to Empty.
<E_Record_Subtype>: Set it to the Cloned_Subtype, if any.  For
types, back-annotate alignment and size values earlier and only
if the DECL was created here; otherwise, if gnat_annotate_type
is present, take the values from it.
(gnat_to_gnu_field): Add gnat_clause local variable.  If a
component clause is present, call validate_size only once on the
Esize of the component.  Otherwise, in the packed case, do not
call validate_size again on the type of the component but
retrieve directly its RM size.
(components_to_record): Minor tweak.
(set_rm_size): Remove useless test.
* gcc-interface/trans.c (gnat_to_gnu): Do wrap the instance of a
boolean discriminant attached to a variant part.

From-SVN: r267008

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/trans.c

index d9dfb22..1fd528c 100644 (file)
@@ -1,3 +1,21 @@
+2018-12-11  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/decl.c (gnat_to_gnu_entity): Add
+       gnat_annotate_type local variable initialized to Empty.
+       <E_Record_Subtype>: Set it to the Cloned_Subtype, if any.  For
+       types, back-annotate alignment and size values earlier and only
+       if the DECL was created here; otherwise, if gnat_annotate_type
+       is present, take the values from it.
+       (gnat_to_gnu_field): Add gnat_clause local variable.  If a
+       component clause is present, call validate_size only once on the
+       Esize of the component.  Otherwise, in the packed case, do not
+       call validate_size again on the type of the component but
+       retrieve directly its RM size.
+       (components_to_record): Minor tweak.
+       (set_rm_size): Remove useless test.
+       * gcc-interface/trans.c (gnat_to_gnu): Do wrap the instance of a
+       boolean discriminant attached to a variant part.
+
 2018-12-11  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_aggr.adb (Array_Aggr_Subtype. Resolve_Aggr_Expr): Indicate
index eaa1a52..b2f9229 100644 (file)
@@ -287,6 +287,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
   const bool foreign = Has_Foreign_Convention (gnat_entity);
   /* For a type, contains the equivalent GNAT node to be used in gigi.  */
   Entity_Id gnat_equiv_type = Empty;
+  /* For a type, contains the GNAT node to be used for back-annotation.  */
+  Entity_Id gnat_annotate_type = Empty;
   /* Temporary used to walk the GNAT tree.  */
   Entity_Id gnat_temp;
   /* Contains the GCC DECL node which is equivalent to the input GNAT node.
@@ -3390,6 +3392,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
        {
          gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
                                         NULL_TREE, false);
+         gnat_annotate_type = Cloned_Subtype (gnat_entity);
          saved = true;
          break;
        }
@@ -4228,7 +4231,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
       saved = true;
     }
 
-  /* If we are processing a type and there is either no decl for it or
+  /* If we are processing a type and there is either no DECL for it or
      we just made one, do some common processing for the type, such as
      handling alignment and possible padding.  */
   if (is_type && (!gnu_decl || this_made_decl))
@@ -4324,6 +4327,97 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
         because we need to accept arbitrary RM sizes on integral types.  */
       set_rm_size (RM_Size (gnat_entity), gnu_type, gnat_entity);
 
+      /* Back-annotate the alignment of the type if not already set.  */
+      if (Unknown_Alignment (gnat_entity))
+       {
+         unsigned int double_align, align;
+         bool is_capped_double, align_clause;
+
+         /* If the default alignment of "double" or larger scalar types is
+            specifically capped and this is not an array with an alignment
+            clause on the component type, return the cap.  */
+         if ((double_align = double_float_alignment) > 0)
+           is_capped_double
+             = is_double_float_or_array (gnat_entity, &align_clause);
+         else if ((double_align = double_scalar_alignment) > 0)
+           is_capped_double
+             = is_double_scalar_or_array (gnat_entity, &align_clause);
+         else
+           is_capped_double = align_clause = false;
+
+         if (is_capped_double && !align_clause)
+           align = double_align;
+         else
+           align = TYPE_ALIGN (gnu_type) / BITS_PER_UNIT;
+
+         Set_Alignment (gnat_entity, UI_From_Int (align));
+       }
+
+      /* Likewise for the size, if any.  */
+      if (Unknown_Esize (gnat_entity) && TYPE_SIZE (gnu_type))
+       {
+         tree gnu_size = TYPE_SIZE (gnu_type);
+
+         /* If the size is self-referential, annotate the maximum value.  */
+         if (CONTAINS_PLACEHOLDER_P (gnu_size))
+           gnu_size = max_size (gnu_size, true);
+
+         /* 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)))))
+           {
+             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
+               {
+                 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);
+             Set_Esize (gnat_entity, annotate_value (gnu_size));
+           }
+
+         /* Otherwise no adjustment is needed.  */
+         else
+           Set_Esize (gnat_entity, annotate_value (gnu_size));
+       }
+
+      /* Likewise for the RM size, if any.  */
+      if (Unknown_RM_Size (gnat_entity) && TYPE_SIZE (gnu_type))
+       Set_RM_Size (gnat_entity, annotate_value (rm_size (gnu_type)));
+
       /* If we are at global level, GCC will have applied variable_size to
         the type, but that won't have done anything.  So, if it's not
         a constant or self-referential, call elaborate_expression_1 to
@@ -4575,99 +4669,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
                                     debug_info_p, gnat_entity);
     }
 
-  /* If we got a type that is not dummy, back-annotate the alignment of the
-     type if not already in the tree.  Likewise for the size, if any.  */
-  if (is_type && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl)))
+  /* Otherwise, for a type reusing an existing DECL, back-annotate values.  */
+  else if (is_type
+          && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
+          && Present (gnat_annotate_type))
     {
-      gnu_type = TREE_TYPE (gnu_decl);
-
       if (Unknown_Alignment (gnat_entity))
-       {
-         unsigned int double_align, align;
-         bool is_capped_double, align_clause;
-
-         /* If the default alignment of "double" or larger scalar types is
-            specifically capped and this is not an array with an alignment
-            clause on the component type, return the cap.  */
-         if ((double_align = double_float_alignment) > 0)
-           is_capped_double
-             = is_double_float_or_array (gnat_entity, &align_clause);
-         else if ((double_align = double_scalar_alignment) > 0)
-           is_capped_double
-             = is_double_scalar_or_array (gnat_entity, &align_clause);
-         else
-           is_capped_double = align_clause = false;
-
-         if (is_capped_double && !align_clause)
-           align = double_align;
-         else
-           align = TYPE_ALIGN (gnu_type) / BITS_PER_UNIT;
-
-         Set_Alignment (gnat_entity, UI_From_Int (align));
-       }
-
-      if (Unknown_Esize (gnat_entity) && TYPE_SIZE (gnu_type))
-       {
-         tree gnu_size = TYPE_SIZE (gnu_type);
-
-         /* If the size is self-referential, annotate the maximum value.  */
-         if (CONTAINS_PLACEHOLDER_P (gnu_size))
-           gnu_size = max_size (gnu_size, true);
-
-         /* 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)))))
-           {
-             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
-               {
-                 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);
-             Set_Esize (gnat_entity, annotate_value (gnu_size));
-           }
-
-         /* Otherwise no adjustment is needed.  */
-         else
-           Set_Esize (gnat_entity, annotate_value (gnu_size));
-       }
-
-      if (Unknown_RM_Size (gnat_entity) && TYPE_SIZE (gnu_type))
-       Set_RM_Size (gnat_entity, annotate_value (rm_size (gnu_type)));
+       Set_Alignment (gnat_entity, Alignment (gnat_annotate_type));
+      if (Unknown_Esize (gnat_entity))
+       Set_Esize (gnat_entity, Esize (gnat_annotate_type));
+      if (Unknown_RM_Size (gnat_entity))
+       Set_RM_Size (gnat_entity, RM_Size (gnat_annotate_type));
     }
 
   /* If we haven't already, associate the ..._DECL node that we just made with
@@ -6900,6 +6912,7 @@ static tree
 gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
                   bool definition, bool debug_info_p)
 {
+  const Node_Id gnat_clause = Component_Clause (gnat_field);
   const Entity_Id gnat_record_type = Underlying_Type (Scope (gnat_field));
   const Entity_Id gnat_field_type = Etype (gnat_field);
   const bool is_atomic
@@ -6934,12 +6947,15 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
   /* If a size is specified, use it.  Otherwise, if the record type is packed,
      use the official RM size.  See "Handling of Type'Size Values" in Einfo
      for further details.  */
-  if (Known_Esize (gnat_field))
-    gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
-                             gnat_field, FIELD_DECL, false, true);
+  if (Known_Esize (gnat_field) || Present (gnat_clause))
+    gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnat_field,
+                             FIELD_DECL, false, true);
   else if (packed == 1)
-    gnu_size = validate_size (RM_Size (gnat_field_type), gnu_field_type,
-                             gnat_field, FIELD_DECL, false, true);
+    {
+      gnu_size = rm_size (gnu_field_type);
+      if (TREE_CODE (gnu_size) != INTEGER_CST)
+       gnu_size = NULL_TREE;
+    }
   else
     gnu_size = NULL_TREE;
 
@@ -6972,7 +6988,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
       && (packed == 1
          || (gnu_size
              && (tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type))
-                 || (Present (Component_Clause (gnat_field))
+                 || (Present (gnat_clause)
                      && !(UI_To_Int (Component_Bit_Offset (gnat_field))
                           % BITS_PER_UNIT == 0
                           && value_factor_p (gnu_size, BITS_PER_UNIT)))))))
@@ -6997,14 +7013,11 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
       check_ok_for_atomic_type (gnu_field_type, gnat_field, false);
     }
 
-  if (Present (Component_Clause (gnat_field)))
+  if (Present (gnat_clause))
     {
-      Node_Id gnat_clause = Component_Clause (gnat_field);
       Entity_Id gnat_parent = Parent_Subtype (gnat_record_type);
 
       gnu_pos = UI_To_gnu (Component_Bit_Offset (gnat_field), bitsizetype);
-      gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
-                               gnat_field, FIELD_DECL, false, true);
 
       /* Ensure the position does not overlap with the parent subtype, if there
         is one.  This test is omitted if the parent of the tagged type has a
@@ -7585,7 +7598,9 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type,
       tree gnu_var_name
        = concat_name (get_identifier (Get_Name_String (Chars (gnat_discr))),
                       "XVN");
-      tree gnu_union_type, gnu_union_name;
+      tree gnu_union_name
+       = concat_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name));
+      tree gnu_union_type;
       tree this_first_free_pos, gnu_variant_list = NULL_TREE;
       bool union_field_needs_strict_alignment = false;
       auto_vec <vinfo_t, 16> variant_types;
@@ -7593,9 +7608,6 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type,
       unsigned int variants_align = 0;
       unsigned int i;
 
-      gnu_union_name
-       = concat_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name));
-
       /* Reuse the enclosing union if this is an Unchecked_Union whose fields
         are all in the variant part, to match the layout of C unions.  There
         is an associated check below.  */
@@ -8831,10 +8843,6 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
   if (uint_size == No_Uint)
     return;
 
-  /* Ignore a negative size since that corresponds to our back-annotation.  */
-  if (UI_Lt (uint_size, Uint_0))
-    return;
-
   /* Only issue an error if a Value_Size clause was explicitly given.
      Otherwise, we'd be duplicating an error on the Size clause.  */
   gnat_attr_node
index c2553d8..35b71ef 100644 (file)
@@ -8567,7 +8567,8 @@ gnat_to_gnu (Node_Id gnat_node)
          || kind == N_Indexed_Component
          || kind == N_Selected_Component)
       && TREE_CODE (get_base_type (gnu_result_type)) == BOOLEAN_TYPE
-      && !lvalue_required_p (gnat_node, gnu_result_type, false, false))
+      && !lvalue_required_p (gnat_node, gnu_result_type, false, false)
+      && Nkind (Parent (gnat_node)) != N_Variant_Part)
     {
       gnu_result
        = build_binary_op (NE_EXPR, gnu_result_type,