decl.c (gnat_to_gnu_entity): Add GNAT_DECL local variable and use it throughout.

	* gcc-interface/decl.c (gnat_to_gnu_entity): Add GNAT_DECL local
	variable and use it throughout.
	<E_Variable>: If the nominal subtype of the object is unconstrained,
	compute the Ada size separately and put in on the padding type if the
	size is not fixed.
	<E_Record_Type>: Minor tweak.
	* gcc-interface/misc.c (gnat_type_max_size): Rename max_size_unit
	into max_size_unit throughout.

From-SVN: r262498

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 537a088a3af80386b0b4a1402c16854f9644ed72..ab7d5a178a677b2db64dfa5216576f7ff0767df4 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2018-07-07  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/decl.c (gnat_to_gnu_entity): Add GNAT_DECL local
+       variable and use it throughout.
+       <E_Variable>: If the nominal subtype of the object is unconstrained,
+       compute the Ada size separately and put in on the padding type if the
+       size is not fixed.
+       <E_Record_Type>: Minor tweak.
+       * gcc-interface/misc.c (gnat_type_max_size): Rename max_size_unit
+       into max_size_unit throughout.
+
 2018-07-07  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/gigi.h (add_decl_expr): Adjust prototype.

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 4ccb7f8c0393d9cc19b825430045e0e6411affe0..b98a4581b9304f57d34a04aab311a8e65342e524 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -273,7 +273,9 @@ static bool intrin_profiles_compatible_p (intrin_binding_t *);
 tree
 gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 {
-  /* Contains the kind of the input GNAT node.  */
+  /* The construct that declared the entity.  */
+  const Node_Id gnat_decl = Declaration_Node (gnat_entity);
+  /* The kind of the entity.  */
   const Entity_Kind kind = Ekind (gnat_entity);
   /* True if this is a type.  */
   const bool is_type = IN (kind, Type_Kind);
@@ -578,7 +580,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
       if (definition
          && !gnu_expr
          && No (Address_Clause (gnat_entity))
-         && !No_Initialization (Declaration_Node (gnat_entity))
+         && !No_Initialization (gnat_decl)
          && No (Renamed_Object (gnat_entity)))
        {
          gnu_decl = error_mark_node;
@@ -611,9 +613,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
         may contain N_Expression_With_Actions nodes and thus declarations of
         objects from other units that we need to discard.  */
       if (!definition
-         && !No_Initialization (Declaration_Node (gnat_entity))
+         && !No_Initialization (gnat_decl)
          && !Is_Dispatch_Table_Entity (gnat_entity)
-         && Present (gnat_temp = Expression (Declaration_Node (gnat_entity)))
+         && Present (gnat_temp = Expression (gnat_decl))
          && Nkind (gnat_temp) != N_Allocator
          && (!type_annotate_only || Compile_Time_Known_Value (gnat_temp)))
        gnu_expr = gnat_to_gnu_external (gnat_temp);
@@ -634,9 +636,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
             && !(kind == E_Variable
                  && Present (Linker_Section_Pragma (gnat_entity)))
             && !Treat_As_Volatile (gnat_entity)
-            && (((Nkind (Declaration_Node (gnat_entity))
-                  == N_Object_Declaration)
-                 && Present (Expression (Declaration_Node (gnat_entity))))
+            && (((Nkind (gnat_decl) == N_Object_Declaration)
+                 && Present (Expression (gnat_decl)))
                 || Present (Renamed_Object (gnat_entity))
                 || imported_p));
        bool inner_const_flag = const_flag;
@@ -650,7 +651,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
        bool used_by_ref = false;
        tree gnu_ext_name = NULL_TREE;
        tree renamed_obj = NULL_TREE;
-       tree gnu_object_size;
+       tree gnu_ada_size = NULL_TREE;
 
        /* We need to translate the renamed object even though we are only
           referencing the renaming.  But it may contain a call for which
@@ -755,8 +756,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
          {
            if (gnu_expr && kind == E_Constant)
              {
-               tree size = TYPE_SIZE (TREE_TYPE (gnu_expr));
-               if (CONTAINS_PLACEHOLDER_P (size))
+               gnu_size = TYPE_SIZE (TREE_TYPE (gnu_expr));
+               gnu_ada_size = TYPE_ADA_SIZE (TREE_TYPE (gnu_expr));
+               if (CONTAINS_PLACEHOLDER_P (gnu_size))
                  {
                    /* If the initializing expression is itself a constant,
                       despite having a nominal type with self-referential
@@ -768,27 +770,38 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
                        && (TREE_READONLY (TREE_OPERAND (gnu_expr, 0))
                            || DECL_READONLY_ONCE_ELAB
                               (TREE_OPERAND (gnu_expr, 0))))
-                     gnu_size = DECL_SIZE (TREE_OPERAND (gnu_expr, 0));
+                     {
+                       gnu_size = DECL_SIZE (TREE_OPERAND (gnu_expr, 0));
+                       gnu_ada_size = gnu_size;
+                     }
                    else
-                     gnu_size
-                       = SUBSTITUTE_PLACEHOLDER_IN_EXPR (size, gnu_expr);
+                     {
+                       gnu_size
+                         = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_size,
+                                                           gnu_expr);
+                       gnu_ada_size
+                         = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_ada_size,
+                                                           gnu_expr);
+                     }
                  }
-               else
-                 gnu_size = size;
              }
            /* We may have no GNU_EXPR because No_Initialization is
               set even though there's an Expression.  */
            else if (kind == E_Constant
-                    && (Nkind (Declaration_Node (gnat_entity))
-                        == N_Object_Declaration)
-                    && Present (Expression (Declaration_Node (gnat_entity))))
-             gnu_size
-               = TYPE_SIZE (gnat_to_gnu_type
-                            (Etype
-                             (Expression (Declaration_Node (gnat_entity)))));
+                    && Nkind (gnat_decl) == N_Object_Declaration
+                    && Present (Expression (gnat_decl)))
+             {
+               tree gnu_expr_type
+                 = gnat_to_gnu_type (Etype (Expression (gnat_decl)));
+               gnu_size = TYPE_SIZE (gnu_expr_type);
+               gnu_ada_size = TYPE_ADA_SIZE (gnu_expr_type);
+             }
            else
              {
                gnu_size = max_size (TYPE_SIZE (gnu_type), true);
+               /* We can be called on unconstrained arrays in this mode.  */
+               if (!type_annotate_only)
+                 gnu_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true);
                mutable_p = true;
              }
 
@@ -904,7 +917,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
        /* Make a new type with the desired size and alignment, if needed.
           But do not take into account alignment promotions to compute the
           size of the object.  */
-       gnu_object_size = gnu_size ? gnu_size : TYPE_SIZE (gnu_type);
+       tree gnu_object_size = gnu_size ? gnu_size : TYPE_SIZE (gnu_type);
        if (gnu_size || align > 0)
          {
            tree orig_type = gnu_type;
@@ -912,6 +925,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
            gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
                                       false, false, definition, true);
 
+           /* If the nominal subtype of the object is unconstrained and its
+              size is not fixed, compute the Ada size from the Ada size of
+              the subtype and/or the expression; this will make it possible
+              for gnat_type_max_size to easily compute a maximum size.  */
+           if (gnu_ada_size && gnu_size && !TREE_CONSTANT (gnu_size))
+             SET_TYPE_ADA_SIZE (gnu_type, gnu_ada_size);
+
            /* If a padding record was made, declare it now since it will
               never be declared otherwise.  This is necessary to ensure
               that its subtrees are properly marked.  */
@@ -2941,23 +2961,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
        the tree.  */
 
     case E_Record_Type:
-      if (Has_Complex_Representation (gnat_entity))
-       {
-         gnu_type
-           = build_complex_type
-             (get_unpadded_type
-              (Etype (Defining_Entity
-                      (First (Component_Items
-                              (Component_List
-                               (Type_Definition
-                                (Declaration_Node (gnat_entity)))))))));
+      {
+       Node_Id record_definition = Type_Definition (gnat_decl);
 
-         break;
-       }
+       if (Has_Complex_Representation (gnat_entity))
+         {
+           const Node_Id first_component
+             = First (Component_Items (Component_List (record_definition)));
+           tree gnu_component_type
+             = get_unpadded_type (Etype (Defining_Entity (first_component)));
+           gnu_type = build_complex_type (gnu_component_type);
+           break;
+         }
 
-      {
-       Node_Id full_definition = Declaration_Node (gnat_entity);
-       Node_Id record_definition = Type_Definition (full_definition);
        Node_Id gnat_constr;
        Entity_Id gnat_field, gnat_parent_type;
        tree gnu_field, gnu_field_list = NULL_TREE;

diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c
index e4efa21d740959519c3e9a50e5a85a584dd7cd74..0bcd385de72d7ca2a5239f0ba301955026b5aa1b 100644 (file)
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -736,25 +736,25 @@ gnat_type_max_size (const_tree gnu_type)
   /* First see what we can get from TYPE_SIZE_UNIT, which might not
      be constant even for simple expressions if it has already been
      elaborated and possibly replaced by a VAR_DECL.  */
-  tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true);
+  tree max_size_unit = max_size (TYPE_SIZE_UNIT (gnu_type), true);
 
   /* If we don't have a constant, try to look at attributes which should have
      stayed untouched.  */
-  if (!tree_fits_uhwi_p (max_unitsize))
+  if (!tree_fits_uhwi_p (max_size_unit))
     {
       /* For record types, see what we can get from TYPE_ADA_SIZE.  */
       if (RECORD_OR_UNION_TYPE_P (gnu_type)
          && !TYPE_FAT_POINTER_P (gnu_type)
          && TYPE_ADA_SIZE (gnu_type))
        {
-         tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true);
+         tree max_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true);
 
          /* If we have succeeded in finding a constant, round it up to the
             type's alignment and return the result in units.  */
-         if (tree_fits_uhwi_p (max_adasize))
-           max_unitsize
+         if (tree_fits_uhwi_p (max_ada_size))
+           max_size_unit
              = size_binop (CEIL_DIV_EXPR,
-                           round_up (max_adasize, TYPE_ALIGN (gnu_type)),
+                           round_up (max_ada_size, TYPE_ALIGN (gnu_type)),
                            bitsize_unit_node);
        }
 
@@ -784,7 +784,7 @@ gnat_type_max_size (const_tree gnu_type)
                    = fold_build2 (PLUS_EXPR, ctype,
                                   fold_build2 (MINUS_EXPR, ctype, hb, lb),
                                   build_int_cst (ctype, 1));
-                 max_unitsize
+                 max_size_unit
                    = fold_build2 (MULT_EXPR, sizetype,
                                   fold_convert (sizetype, length),
                                   TYPE_SIZE_UNIT (TREE_TYPE (gnu_type)));
@@ -793,7 +793,7 @@ gnat_type_max_size (const_tree gnu_type)
        }
     }
 
-  return max_unitsize;
+  return max_size_unit;
 }
 
 static tree get_array_bit_stride (tree);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f8a33d809b38c71c3b58d5b5b0a207da4d44a694..1534e922320b0c32cf0e01e8d50261f9046c2ea7 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-07-07  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/stack_usage6.adb: New test.
+       * gnat.dg/stack_usage6_pkg.ads: New helper.
+
 2018-07-07  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/pure_function3a.adb: New test.

diff --git a/gcc/testsuite/gnat.dg/stack_usage6.adb b/gcc/testsuite/gnat.dg/stack_usage6.adb
new file mode 100644 (file)
index 0000000..d02da6c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/stack_usage6.adb
@@ -0,0 +1,12 @@
+-- { dg-do compile }
+-- { dg-options "-Wstack-usage=512" }
+
+with Stack_Usage6_Pkg; use Stack_Usage6_Pkg;
+
+procedure Stack_Usage6 (I : Index_Type) is
+   R : constant Rec := A (I);
+begin
+   if R.D then
+     raise Program_Error;
+   end if;
+end;

diff --git a/gcc/testsuite/gnat.dg/stack_usage6_pkg.ads b/gcc/testsuite/gnat.dg/stack_usage6_pkg.ads
new file mode 100644 (file)
index 0000000..f855376
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/stack_usage6_pkg.ads
@@ -0,0 +1,19 @@
+package Stack_Usage6_Pkg is
+
+   type Rec (D : Boolean := False) is record
+      case D is
+         when False =>
+            Foo : Integer;
+            Bar : Integer;
+         when True =>
+            null;
+      end case;
+   end record;
+
+   type Index_Type is new Integer range 0 .. 5;
+
+   type Arr is array (Index_Type) of Rec;
+
+   A : Arr;
+   
+end Stack_Usage6_Pkg;