[Ada] Robustify renaming code in gigi

Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c	(revision 209410)
+++ gcc-interface/utils.c	(working copy)
@@ -2514,7 +2514,10 @@  record_global_renaming_pointer (tree dec
   vec_safe_push (global_renaming_pointers, decl);
 }
 
-/* Invalidate the global renaming pointers.   */
+/* Invalidate the global renaming pointers that are not constant, lest their
+   renamed object contains SAVE_EXPRs tied to an elaboration routine.  Note
+   that we should not blindly invalidate everything here because of the need
+   to propagate constant values through renaming.  */
 
 void
 invalidate_global_renaming_pointers (void)
@@ -2526,7 +2529,8 @@  invalidate_global_renaming_pointers (voi
     return;
 
   FOR_EACH_VEC_ELT (*global_renaming_pointers, i, iter)
-    SET_DECL_RENAMED_OBJECT (iter, NULL_TREE);
+    if (!TREE_CONSTANT (DECL_RENAMED_OBJECT (iter)))
+      SET_DECL_RENAMED_OBJECT (iter, NULL_TREE);
 
   vec_free (global_renaming_pointers);
 }
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 209409)
+++ gcc-interface/decl.c	(working copy)
@@ -960,18 +960,20 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	      gnu_type = TREE_TYPE (gnu_expr);
 
 	    /* Case 1: If this is a constant renaming stemming from a function
-	       call, treat it as a normal object whose initial value is what
-	       is being renamed.  RM 3.3 says that the result of evaluating a
-	       function call is a constant object.  As a consequence, it can
-	       be the inner object of a constant renaming.  In this case, the
-	       renaming must be fully instantiated, i.e. it cannot be a mere
-	       reference to (part of) an existing object.  */
+	       call, treat it as a normal object whose initial value is what is
+	       being renamed.  RM 3.3 says that the result of evaluating a
+	       function call is a constant object.  Treat constant literals
+	       the same way.  As a consequence, it can be the inner object of
+	       a constant renaming.  In this case, the renaming must be fully
+	       instantiated, i.e. it cannot be a mere reference to (part of) an
+	       existing object.  */
 	    if (const_flag)
 	      {
 	        tree inner_object = gnu_expr;
 		while (handled_component_p (inner_object))
 		  inner_object = TREE_OPERAND (inner_object, 0);
-		if (TREE_CODE (inner_object) == CALL_EXPR)
+		if (TREE_CODE (inner_object) == CALL_EXPR
+		    || CONSTANT_CLASS_P (inner_object))
 		  create_normal_object = true;
 	      }
 
@@ -1030,15 +1032,7 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 		       about that failure.  */
 		  }
 
-		/* Case 3: If this is a constant renaming and creating a
-		   new object is allowed and cheap, treat it as a normal
-		   object whose initial value is what is being renamed.  */
-		if (const_flag
-		    && !Is_Composite_Type
-		        (Underlying_Type (Etype (gnat_entity))))
-		  ;
-
-		/* Case 4: Make this into a constant pointer to the object we
+		/* Case 3: Make this into a constant pointer to the object we
 		   are to rename and attach the object to the pointer if it is
 		   something we can stabilize.
 
@@ -1050,68 +1044,59 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 		   The pointer is called a "renaming" pointer in this case.
 
 		   In the rare cases where we cannot stabilize the renamed
-		   object, we just make a "bare" pointer, and the renamed
-		   entity is always accessed indirectly through it.  */
-		else
-		  {
-		    /* We need to preserve the volatileness of the renamed
-		       object through the indirection.  */
-		    if (TREE_THIS_VOLATILE (gnu_expr)
-			&& !TYPE_VOLATILE (gnu_type))
-		      gnu_type
-			= build_qualified_type (gnu_type,
-						(TYPE_QUALS (gnu_type)
-						 | TYPE_QUAL_VOLATILE));
-		    gnu_type = build_reference_type (gnu_type);
-		    inner_const_flag = TREE_READONLY (gnu_expr);
-		    const_flag = true;
+		   object, we just make a "bare" pointer and the renamed
+		   object will always be accessed indirectly through it.
 
-		    /* If the previous attempt at stabilizing failed, there
-		       is no point in trying again and we reuse the result
-		       without attaching it to the pointer.  In this case it
-		       will only be used as the initializing expression of
-		       the pointer and thus needs no special treatment with
-		       regard to multiple evaluations.  */
-		    if (maybe_stable_expr)
-		      ;
-
-		    /* Otherwise, try to stabilize and attach the expression
-		       to the pointer if the stabilization succeeds.
-
-		       Note that this might introduce SAVE_EXPRs and we don't
-		       check whether we're at the global level or not.  This
-		       is fine since we are building a pointer initializer and
-		       neither the pointer nor the initializing expression can
-		       be accessed before the pointer elaboration has taken
-		       place in a correct program.
-
-		       These SAVE_EXPRs will be evaluated at the right place
-		       by either the evaluation of the initializer for the
-		       non-global case or the elaboration code for the global
-		       case, and will be attached to the elaboration procedure
-		       in the latter case.  */
-		    else
-	 	     {
-			maybe_stable_expr
-			  = gnat_stabilize_reference (gnu_expr, true, &stable);
+		   Note that we need to preserve the volatility of the renamed
+		   object through the indirection.  */
+		if (TREE_THIS_VOLATILE (gnu_expr) && !TYPE_VOLATILE (gnu_type))
+		  gnu_type = build_qualified_type (gnu_type,
+						   (TYPE_QUALS (gnu_type)
+						    | TYPE_QUAL_VOLATILE));
+		gnu_type = build_reference_type (gnu_type);
+		inner_const_flag = TREE_READONLY (gnu_expr);
+		const_flag = true;
 
-			if (stable)
-			  renamed_obj = maybe_stable_expr;
+		/* If the previous attempt at stabilizing failed, there is
+		   no point in trying again and we reuse the result without
+		   attaching it to the pointer.  In this case it will only
+		   be used as the initializing expression of the pointer and
+		   thus needs no special treatment with regard to multiple
+		   evaluations.
+
+		   Otherwise, try to stabilize and attach the expression to
+		   the pointer if the stabilization succeeds.
+
+		   Note that this might introduce SAVE_EXPRs and we don't
+		   check whether we are at the global level or not.  This
+		   is fine since we are building a pointer initializer and
+		   neither the pointer nor the initializing expression can
+		   be accessed before the pointer elaboration has taken
+		   place in a correct program.
+
+		   These SAVE_EXPRs will be evaluated at the right place
+		   by either the evaluation of the initializer for the
+		   non-global case or the elaboration code for the global
+		   case, and will be attached to the elaboration procedure
+		   in the latter case.  */
+		if (!maybe_stable_expr)
+		  {
+		    maybe_stable_expr
+		      = gnat_stabilize_reference (gnu_expr, true, &stable);
 
-			/* Attaching is actually performed downstream, as soon
-			   as we have a VAR_DECL for the pointer we make.  */
-		      }
+		    if (stable)
+		      renamed_obj = maybe_stable_expr;
+		  }
 
-		    if (type_annotate_only
- 			&& TREE_CODE (maybe_stable_expr) == ERROR_MARK)
-		      gnu_expr = NULL_TREE;
-		    else
-		      gnu_expr = build_unary_op (ADDR_EXPR, gnu_type,
-						 maybe_stable_expr);
+		if (type_annotate_only
+ 		    && TREE_CODE (maybe_stable_expr) == ERROR_MARK)
+		  gnu_expr = NULL_TREE;
+		else
+		  gnu_expr
+		    = build_unary_op (ADDR_EXPR, gnu_type, maybe_stable_expr);
 
-		    gnu_size = NULL_TREE;
-		    used_by_ref = true;
-		  }
+		gnu_size = NULL_TREE;
+		used_by_ref = true;
 	      }
 	  }
 
@@ -1483,10 +1468,10 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 
 	/* Now create the variable or the constant and set various flags.  */
 	gnu_decl
-	  = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
-			     gnu_expr, const_flag, Is_Public (gnat_entity),
-			     imported_p || !definition, static_p, attr_list,
-			     gnat_entity);
+	  = create_var_decl_1 (gnu_entity_name, gnu_ext_name, gnu_type,
+			       gnu_expr, const_flag, Is_Public (gnat_entity),
+			       imported_p || !definition, static_p,
+			       !renamed_obj, attr_list, gnat_entity);
 	DECL_BY_REF_P (gnu_decl) = used_by_ref;
 	DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
 	DECL_CAN_NEVER_BE_NULL_P (gnu_decl) = Can_Never_Be_Null (gnat_entity);
@@ -1517,7 +1502,7 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	/* If this is a renaming pointer, attach the renamed object to it and
 	   register it if we are at the global level.  Note that an external
 	   constant is at the global level.  */
-	if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
+	if (renamed_obj)
 	  {
 	    SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
 	    if ((!definition && kind == E_Constant) || global_bindings_p ())
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 209404)
+++ gcc-interface/trans.c	(working copy)
@@ -898,17 +898,8 @@  lvalue_required_p (Node_Id gnat_node, tr
 				address_of_constant, aliased);
 
     case N_Object_Renaming_Declaration:
-      /* We need to make a real renaming only if the constant object is
-	 aliased or if we may use a renaming pointer; otherwise we can
-	 optimize and return the rvalue.  We make an exception if the object
-	 is an identifier since in this case the rvalue can be propagated
-	 attached to the CONST_DECL.  */
-      return (!constant
-	      || aliased
-	      /* This should match the constant case of the renaming code.  */
-	      || Is_Composite_Type
-		 (Underlying_Type (Etype (Name (gnat_parent))))
-	      || Nkind (Name (gnat_parent)) == N_Identifier);
+      /* We need to preserve addresses through a renaming.  */
+      return 1;
 
     case N_Object_Declaration:
       /* We cannot use a constructor if this is an atomic object because
@@ -968,6 +959,77 @@  lvalue_required_p (Node_Id gnat_node, tr
   gcc_unreachable ();
 }
 
+/* Return true if T is a constant DECL node that can be safely replaced
+   by its initializer.  */
+
+static bool
+constant_decl_with_initializer_p (tree t)
+{
+  if (!TREE_CONSTANT (t) || !DECL_P (t) || !DECL_INITIAL (t))
+    return false;
+
+  /* Return false for aggregate types that contain a placeholder since
+     their initializers cannot be manipulated easily.  */
+  if (AGGREGATE_TYPE_P (TREE_TYPE (t))
+      && !TYPE_IS_FAT_POINTER_P (TREE_TYPE (t))
+      && type_contains_placeholder_p (TREE_TYPE (t)))
+    return false;
+
+  return true;
+}
+
+/* Return an expression equivalent to EXP but where constant DECL nodes
+   have been replaced by their initializer.  */
+
+static tree
+fold_constant_decl_in_expr (tree exp)
+{
+  enum tree_code code = TREE_CODE (exp);
+  tree op0;
+
+  switch (code)
+    {
+    case CONST_DECL:
+    case VAR_DECL:
+      if (!constant_decl_with_initializer_p (exp))
+	return exp;
+
+      return DECL_INITIAL (exp);
+
+    case BIT_FIELD_REF:
+    case COMPONENT_REF:
+      op0 = fold_constant_decl_in_expr (TREE_OPERAND (exp, 0));
+      if (op0 == TREE_OPERAND (exp, 0))
+	return exp;
+
+      return fold_build3 (code, TREE_TYPE (exp), op0, TREE_OPERAND (exp, 1),
+			  TREE_OPERAND (exp, 2));
+
+    case ARRAY_REF:
+    case ARRAY_RANGE_REF:
+      op0 = fold_constant_decl_in_expr (TREE_OPERAND (exp, 0));
+      if (op0 == TREE_OPERAND (exp, 0))
+	return exp;
+
+      return fold (build4 (code, TREE_TYPE (exp), op0, TREE_OPERAND (exp, 1),
+			   TREE_OPERAND (exp, 2), TREE_OPERAND (exp, 3)));
+
+    case VIEW_CONVERT_EXPR:
+    case REALPART_EXPR:
+    case IMAGPART_EXPR:
+      op0 = fold_constant_decl_in_expr (TREE_OPERAND (exp, 0));
+      if (op0 == TREE_OPERAND (exp, 0))
+	return exp;
+
+      return fold_build1 (code, TREE_TYPE (exp), op0);
+
+    default:
+      return exp;
+    }
+
+  gcc_unreachable ();
+}
+
 /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Identifier,
    to a GCC tree, which is returned.  GNU_RESULT_TYPE_P is a pointer
    to where we should place the result type.  */
@@ -1112,13 +1174,16 @@  Identifier_to_gnu (Node_Id gnat_node, tr
 					  true, false)))
 	gnu_result = DECL_INITIAL (gnu_result);
 
-      /* If it's a renaming pointer and we are at the right binding level,
-	 we can reference the renamed object directly, since the renamed
-	 expression has been protected against multiple evaluations.  */
+      /* If it's a renaming pointer and, either the renamed object is constant
+	 or we are at the right binding level, we can reference the renamed
+	 object directly, since it is constant or has been protected against
+	 multiple evaluations.  */
       if (TREE_CODE (gnu_result) == VAR_DECL
           && !DECL_LOOP_PARM_P (gnu_result)
 	  && DECL_RENAMED_OBJECT (gnu_result)
-	  && (!DECL_RENAMING_GLOBAL_P (gnu_result) || global_bindings_p ()))
+	  && (TREE_CONSTANT (DECL_RENAMED_OBJECT (gnu_result))
+	      || !DECL_RENAMING_GLOBAL_P (gnu_result)
+	      || global_bindings_p ()))
 	gnu_result = DECL_RENAMED_OBJECT (gnu_result);
 
       /* Otherwise, do the final dereference.  */
@@ -1138,15 +1203,8 @@  Identifier_to_gnu (Node_Id gnat_node, tr
 
   /* If we have a constant declaration and its initializer, try to return the
      latter to avoid the need to call fold in lots of places and the need for
-     elaboration code if this identifier is used as an initializer itself.
-     Don't do it for aggregate types that contain a placeholder since their
-     initializers cannot be manipulated easily.  */
-  if (TREE_CONSTANT (gnu_result)
-      && DECL_P (gnu_result)
-      && DECL_INITIAL (gnu_result)
-      && !(AGGREGATE_TYPE_P (TREE_TYPE (gnu_result))
-	   && !TYPE_IS_FAT_POINTER_P (TREE_TYPE (gnu_result))
-	   && type_contains_placeholder_p (TREE_TYPE (gnu_result))))
+     elaboration code if this identifier is used as an initializer itself.  */
+  if (constant_decl_with_initializer_p (gnu_result))
     {
       bool constant_only = (TREE_CODE (gnu_result) == CONST_DECL
 			    && !DECL_CONST_CORRESPONDING_VAR (gnu_result));
@@ -1166,6 +1224,21 @@  Identifier_to_gnu (Node_Id gnat_node, tr
 	gnu_result = DECL_INITIAL (gnu_result);
     }
 
+  /* But for a constant renaming we couldn't do that incrementally for its
+     definition because of the need to return an lvalue so, if the present
+     context doesn't itself require an lvalue, we try again here.  */
+  else if (Ekind (gnat_temp) == E_Constant
+	   && Is_Elementary_Type (gnat_temp_type)
+	   && Present (Renamed_Object (gnat_temp)))
+    {
+      if (require_lvalue < 0)
+	require_lvalue
+	  = lvalue_required_p (gnat_node, gnu_result_type, true, false,
+			       Is_Aliased (gnat_temp));
+      if (!require_lvalue)
+	gnu_result = fold_constant_decl_in_expr (gnu_result);
+    }
+
   /* The GNAT tree has the type of a function set to its result type, so we
      adjust here.  Also use the type of the result if the Etype is a subtype
      that is nominally unconstrained.  Likewise if this is a deferred constant
@@ -2327,9 +2400,11 @@  Case_Statement_to_gnu (Node_Id gnat_node
       /* First compile all the different case choices for the current WHEN
 	 alternative.  */
       for (gnat_choice = First (Discrete_Choices (gnat_when));
-	   Present (gnat_choice); gnat_choice = Next (gnat_choice))
+	   Present (gnat_choice);
+	   gnat_choice = Next (gnat_choice))
 	{
 	  tree gnu_low = NULL_TREE, gnu_high = NULL_TREE;
+	  tree label = create_artificial_label (input_location);
 
 	  switch (Nkind (gnat_choice))
 	    {
@@ -2353,8 +2428,8 @@  Case_Statement_to_gnu (Node_Id gnat_node
 		{
 		  tree gnu_type = get_unpadded_type (Entity (gnat_choice));
 
-		  gnu_low = fold (TYPE_MIN_VALUE (gnu_type));
-		  gnu_high = fold (TYPE_MAX_VALUE (gnu_type));
+		  gnu_low = TYPE_MIN_VALUE (gnu_type);
+		  gnu_high = TYPE_MAX_VALUE (gnu_type);
 		  break;
 		}
 
@@ -2372,20 +2447,13 @@  Case_Statement_to_gnu (Node_Id gnat_node
 	      gcc_unreachable ();
 	    }
 
-	  /* If the case value is a subtype that raises Constraint_Error at
-	     run time because of a wrong bound, then gnu_low or gnu_high is
-	     not translated into an INTEGER_CST.  In such a case, we need
-	     to ensure that the when statement is not added in the tree,
-	     otherwise it will crash the gimplifier.  */
-	  if ((!gnu_low || TREE_CODE (gnu_low) == INTEGER_CST)
-	      && (!gnu_high || TREE_CODE (gnu_high) == INTEGER_CST))
-	    {
-	      add_stmt_with_node (build_case_label
-				  (gnu_low, gnu_high,
-				   create_artificial_label (input_location)),
-				  gnat_choice);
-	      choices_added_p = true;
-	    }
+	  /* Everything should be folded into constants at this point.  */
+	  gcc_assert (!gnu_low  || TREE_CODE (gnu_low)  == INTEGER_CST);
+	  gcc_assert (!gnu_high || TREE_CODE (gnu_high) == INTEGER_CST);
+
+	  add_stmt_with_node (build_case_label (gnu_low, gnu_high, label),
+			      gnat_choice);
+	  choices_added_p = true;
 	}
 
       /* This construct doesn't define a scope so we shouldn't push a binding