trans.c (gnat_to_gnu): Really force evaluation of the expression...

	* gcc-interface/trans.c (gnat_to_gnu) <N_Object_Declaration>: Really
	force evaluation of the expression, if any, when the object has its
	elaboration delayed.  Do not create a variable at global level.

From-SVN: r223716

gcc/ada/ChangeLog

 2015-05-26  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/trans.c (gnat_to_gnu) <N_Object_Declaration>: Really
+	force evaluation of the expression, if any, when the object has its
+	elaboration delayed.  Do not create a variable at global level.
+
+2015-05-26  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Machine>: Do not apply
 	extra-precision trick to literals.  Build SAVE_EXPR manually.
 

gcc/ada/gcc-interface/trans.c

@@ -5791,31 +5791,12 @@ gnat_to_gnu (Node_Id gnat_node)
 	    gnu_expr
 	      = emit_range_check (gnu_expr, Etype (gnat_temp), gnat_node);
 
-	  /* If this object has its elaboration delayed, we must force
-	     evaluation of GNU_EXPR right now and save it for when the object
-	     is frozen.  */
-	  if (Present (Freeze_Node (gnat_temp)))
-	    {
-	      if (TREE_CONSTANT (gnu_expr))
-		;
-	      else if (global_bindings_p ())
-		gnu_expr
-		  = create_var_decl (create_concat_name (gnat_temp, "init"),
-				     NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr,
-				     false, false, false, false,
-				     NULL, gnat_temp);
-	      else
-		gnu_expr = gnat_save_expr (gnu_expr);
-
-	      save_gnu_tree (gnat_node, gnu_expr, true);
-	    }
+	  if (type_annotate_only && TREE_CODE (gnu_expr) == ERROR_MARK)
+	    gnu_expr = NULL_TREE;
 	}
       else
 	gnu_expr = NULL_TREE;
 
-      if (type_annotate_only && gnu_expr && TREE_CODE (gnu_expr) == ERROR_MARK)
-	gnu_expr = NULL_TREE;
-
       /* If this is a deferred constant with an address clause, we ignore the
 	 full view since the clause is on the partial view and we cannot have
 	 2 different GCC trees for the object.  The only bits of the full view
@@ -5825,7 +5806,19 @@ gnat_to_gnu (Node_Id gnat_node)
 	  && Present (Full_View (gnat_temp)))
 	save_gnu_tree (Full_View (gnat_temp), error_mark_node, true);
 
-      if (No (Freeze_Node (gnat_temp)))
+      /* If this object has its elaboration delayed, we must force evaluation
+	 of GNU_EXPR now and save it for the freeze point.  Note that we need
+	 not do anything special at the global level since the lifetime of the
+	 temporary is fully contained within the elaboration routine.  */
+      if (Present (Freeze_Node (gnat_temp)))
+	{
+	  if (gnu_expr)
+	    {
+	      gnu_result = gnat_save_expr (gnu_expr);
+	      save_gnu_tree (gnat_node, gnu_result, true);
+	    }
+	}
+      else
 	gnat_to_gnu_entity (gnat_temp, gnu_expr, 1);
       break;
 

gcc/testsuite/ChangeLog

+2015-05-26  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/atomic7_1.adb: New test.
+	* gnat.dg/atomic7_2.adb: Likewise.
+	* gnat.dg/atomic7_pkg1.ads: New helper.
+	* gnat.dg/atomic7_pkg2.ad[sb]: Likewise.
+
 2015-05-26  Michael Matz  <matz@suse.de>
 
 	PR middle-end/66251

gcc/testsuite/gnat.dg/atomic7_1.adb

+-- { dg-do run }
+
+with Atomic7_Pkg2; use Atomic7_Pkg2;
+
+procedure Atomic7_1 is
+
+  I : Integer := Stamp;
+  pragma Atomic (I);
+
+  J : Integer := Stamp;
+
+begin
+  if I /= 1 then
+    raise Program_Error;
+  end if;
+end;

gcc/testsuite/gnat.dg/atomic7_2.adb

+--- { dg-do run }
+
+with Atomic7_Pkg1; use Atomic7_Pkg1;
+
+procedure Atomic7_2 is
+begin
+  if I /= 1 then
+    raise Program_Error;
+  end if;
+end;

gcc/testsuite/gnat.dg/atomic7_pkg1.ads

+with Atomic7_Pkg2; use Atomic7_Pkg2;
+
+package Atomic7_Pkg1 is
+
+  I : Integer := Stamp;
+  pragma Atomic (I);
+
+  J : Integer := Stamp;
+
+end Atomic7_Pkg1;

gcc/testsuite/gnat.dg/atomic7_pkg2.adb

+pragma Restrictions (No_Elaboration_Code);
+
+package body Atomic7_Pkg2 is
+
+  T : Natural := 0;
+  pragma Atomic (T);
+
+  function Stamp return Natural is
+  begin
+     T := T + 1;
+     return T;
+  end;
+
+end Atomic7_Pkg2;

gcc/testsuite/gnat.dg/atomic7_pkg2.ads

+package Atomic7_Pkg2 is
+
+  function Stamp return Natural;
+
+end Atomic7_Pkg2;