decl.c (elaborate_expression_1): Try harder to find out whether the expression is...

	* gcc-interface/decl.c (elaborate_expression_1): Try harder to find
	out whether the expression is read-only.  Short-circuit placeholder
	case and rename a couple of local variables.

From-SVN: r171106

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 73f85e2..fc87a82 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,11 @@
 2011-03-17  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * gcc-interface/decl.c (elaborate_expression_1): Try harder to find
+       out whether the expression is read-only.  Short-circuit placeholder
+       case and rename a couple of local variables.
+
+2011-03-17  Eric Botcazou  <ebotcazou@adacore.com>
+
        * gcc-interface/gigi.h (smaller_form_type_p): Declare.
        * gcc-interface/trans.c (smaller_form_type_p): Make global and move...
        * gcc-interface/utils.c (smaller_form_type_p): ...to here.

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index a10fc2d..696e49a 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -6003,15 +6003,9 @@ static tree
 elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name,
                        bool definition, bool need_debug)
 {
-  /* Skip any conversions and simple arithmetics to see if the expression
-     is a read-only variable.
-     ??? This really should remain read-only, but we have to think about
-     the typing of the tree here.  */
-  tree gnu_inner_expr
-    = skip_simple_arithmetic (remove_conversions (gnu_expr, true));
-  tree gnu_decl = NULL_TREE;
-  bool expr_global = Is_Public (gnat_entity) || global_bindings_p ();
-  bool expr_variable;
+  const bool expr_global_p = Is_Public (gnat_entity) || global_bindings_p ();
+  bool expr_variable_p;
+  tree gnu_decl;
 
   /* In most cases, we won't see a naked FIELD_DECL because a discriminant
      reference will have been replaced with a COMPONENT_REF when the type
@@ -6023,39 +6017,62 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name,
                       build0 (PLACEHOLDER_EXPR, DECL_CONTEXT (gnu_expr)),
                       gnu_expr, NULL_TREE);
 
-  /* If GNU_EXPR is neither a placeholder nor a constant, nor a variable
-     that is read-only, make a variable that is initialized to contain the
-     bound when the package containing the definition is elaborated.  If
-     this entity is defined at top level and a bound or discriminant value
-     isn't a constant or a reference to a discriminant, replace the bound
-     by the variable; otherwise use a SAVE_EXPR if needed.  Note that we
-     rely here on the fact that an expression cannot contain both the
-     discriminant and some other variable.  */
-  expr_variable = (!CONSTANT_CLASS_P (gnu_expr)
-                  && !(TREE_CODE (gnu_inner_expr) == VAR_DECL
-                       && (TREE_READONLY (gnu_inner_expr)
-                           || DECL_READONLY_ONCE_ELAB (gnu_inner_expr)))
-                  && !CONTAINS_PLACEHOLDER_P (gnu_expr));
-
-  /* If GNU_EXPR contains a discriminant, we can't elaborate a variable.  */
-  if (need_debug && CONTAINS_PLACEHOLDER_P (gnu_expr))
-    need_debug = false;
+  /* If GNU_EXPR contains a placeholder, just return it.  We rely on the fact
+     that an expression cannot contain both a discriminant and a variable.  */
+  if (CONTAINS_PLACEHOLDER_P (gnu_expr))
+    return gnu_expr;
+
+  /* If GNU_EXPR is neither a constant nor based on a read-only variable, make
+     a variable that is initialized to contain the expression when the package
+     containing the definition is elaborated.  If this entity is defined at top
+     level, replace the expression by the variable; otherwise use a SAVE_EXPR
+     if this is necessary.  */
+  if (CONSTANT_CLASS_P (gnu_expr))
+    expr_variable_p = false;
+  else
+    {
+      /* Skip any conversions and simple arithmetics to see if the expression
+        is based on a read-only variable.
+        ??? This really should remain read-only, but we have to think about
+        the typing of the tree here.  */
+      tree inner
+       = skip_simple_arithmetic (remove_conversions (gnu_expr, true));
+
+      if (handled_component_p (inner))
+       {
+         HOST_WIDE_INT bitsize, bitpos;
+         tree offset;
+         enum machine_mode mode;
+         int unsignedp, volatilep;
+
+         inner = get_inner_reference (inner, &bitsize, &bitpos, &offset,
+                                      &mode, &unsignedp, &volatilep, false);
+         /* If the offset is variable, err on the side of caution.  */
+         if (offset)
+           inner = NULL_TREE;
+       }
+
+      expr_variable_p
+       = !(inner
+           && TREE_CODE (inner) == VAR_DECL
+           && (TREE_READONLY (inner) || DECL_READONLY_ONCE_ELAB (inner)));
+    }
 
   /* Now create the variable if we need it.  */
-  if (need_debug || (expr_variable && expr_global))
+  if (need_debug || (expr_variable_p && expr_global_p))
     gnu_decl
       = create_var_decl (create_concat_name (gnat_entity,
                                             IDENTIFIER_POINTER (gnu_name)),
                         NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr,
                         !need_debug, Is_Public (gnat_entity),
-                        !definition, expr_global, NULL, gnat_entity);
+                        !definition, expr_global_p, NULL, gnat_entity);
 
   /* We only need to use this variable if we are in global context since GCC
      can do the right thing in the local case.  */
-  if (expr_global && expr_variable)
+  if (expr_global_p && expr_variable_p)
     return gnu_decl;
 
-  return expr_variable ? gnat_save_expr (gnu_expr) : gnu_expr;
+  return expr_variable_p ? gnat_save_expr (gnu_expr) : gnu_expr;
 }
 
 /* Similar, but take an alignment factor and make it explicit in the tree.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 29d3823..e0b94d4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-03-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/specs/elab2.ads: New test.
+       * gnat.dg/specs/elab2_pkg.ads: New helper.
+
 2011-03-17  Jason Merrill  <jason@redhat.com>
 
        * g++.dg/cpp0x/decltype-1212.C: New.

diff --git a/gcc/testsuite/gnat.dg/specs/elab2.ads b/gcc/testsuite/gnat.dg/specs/elab2.ads
new file mode 100644 (file)
index 0000000..005871b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/elab2.ads
@@ -0,0 +1,20 @@
+-- { dg-do compile }
+
+with Elab2_Pkg; use Elab2_Pkg;
+
+package Elab2 is
+
+   type Num is (One, Two);
+
+   type Rec2 (D : Index_Type := 0) is record
+      Data : Rec1(D);
+   end record;
+
+   type Rec3 (D : Num) is record
+      case D is
+         when One => R : Rec2;
+         when others => null;
+      end case;
+   end record;
+
+end Elab2;

diff --git a/gcc/testsuite/gnat.dg/specs/elab2_pkg.ads b/gcc/testsuite/gnat.dg/specs/elab2_pkg.ads
new file mode 100644 (file)
index 0000000..8d40cd1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/elab2_pkg.ads
@@ -0,0 +1,18 @@
+-- { dg-excess-errors "no code generated" }
+
+package Elab2_Pkg is
+
+   function Get_Value (S : String) return Integer;
+
+   Max_Limit : constant array(1..2) of Integer :=
+     (1 => Get_Value ("One"), 2 => Get_Value ("Two"));
+
+   type Index_Type is new Natural range 0 .. Max_Limit(1);
+
+   type Array_Type is array (Index_Type range <>) of Natural;
+
+   type Rec1(D : Index_Type) is record
+      A : Array_Type(1 .. D);
+   end record;
+
+end Elab2_Pkg;