[Ada] Fix declaration of object with delayed elaboration

[Eric Botcazou <ebotcazou at adacore dot com>]

When an object is declared with an initializing expression and has its 
elaboration delayed, the following code in gnat_to_gnu is invoked:

	  /* 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);
	    }

There are a couple of issues with it:
  1) at global level, creating a variable (which ends up in the .bss section) 
is unnecessary since its lifetime is entirely within the elaboration routine,
  2) at local level, nothing actually forces the evaluation of GNU_EXPR here 
so it is evaluated at the freeze point, which is wrong.

Tested on x86_64-suse-linux, applied on the mainline.


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>

	* 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.


-- 
Eric Botcazou

Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 223715)
+++ gcc-interface/trans.c	(working copy)
@@ -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;
 

-- { 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;

--- { dg-do run }

with Atomic7_Pkg1; use Atomic7_Pkg1;

procedure Atomic7_2 is
begin
  if I /= 1 then
    raise Program_Error;
  end if;
end;

with Atomic7_Pkg2; use Atomic7_Pkg2;

package Atomic7_Pkg1 is

  I : Integer := Stamp;
  pragma Atomic (I);

  J : Integer := Stamp;

end Atomic7_Pkg1;

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;

package Atomic7_Pkg2 is

  function Stamp return Natural;

end Atomic7_Pkg2;