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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d6d7af5defa1e37b9084795ed999784796ebf75f..dcb4620d292f0c0f21f29c7d78421943020f91fd 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index b1c15516bc6e884dd102d6dd032a511aa288a343..8efa59dc86e6cdecf8cd43cd8c5faddd0d206431 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/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;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7ed1c92d27e396652267bd1ad2b3b602cd0782a8..a137eef9c0470ea3b2bced15263062d434b36bf1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+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

diff --git a/gcc/testsuite/gnat.dg/atomic7_1.adb b/gcc/testsuite/gnat.dg/atomic7_1.adb
new file mode 100644 (file)
index 0000000..2cd2fd7
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic7_1.adb
@@ -0,0 +1,16 @@
+-- { 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;

diff --git a/gcc/testsuite/gnat.dg/atomic7_2.adb b/gcc/testsuite/gnat.dg/atomic7_2.adb
new file mode 100644 (file)
index 0000000..5f73e24
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic7_2.adb
@@ -0,0 +1,10 @@
+--- { dg-do run }
+
+with Atomic7_Pkg1; use Atomic7_Pkg1;
+
+procedure Atomic7_2 is
+begin
+  if I /= 1 then
+    raise Program_Error;
+  end if;
+end;

diff --git a/gcc/testsuite/gnat.dg/atomic7_pkg1.ads b/gcc/testsuite/gnat.dg/atomic7_pkg1.ads
new file mode 100644 (file)
index 0000000..6705e04
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic7_pkg1.ads
@@ -0,0 +1,10 @@
+with Atomic7_Pkg2; use Atomic7_Pkg2;
+
+package Atomic7_Pkg1 is
+
+  I : Integer := Stamp;
+  pragma Atomic (I);
+
+  J : Integer := Stamp;
+
+end Atomic7_Pkg1;

diff --git a/gcc/testsuite/gnat.dg/atomic7_pkg2.adb b/gcc/testsuite/gnat.dg/atomic7_pkg2.adb
new file mode 100644 (file)
index 0000000..547c388
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic7_pkg2.adb
@@ -0,0 +1,14 @@
+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;

diff --git a/gcc/testsuite/gnat.dg/atomic7_pkg2.ads b/gcc/testsuite/gnat.dg/atomic7_pkg2.ads
new file mode 100644 (file)
index 0000000..8e46ec3
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic7_pkg2.ads
@@ -0,0 +1,5 @@
+package Atomic7_Pkg2 is
+
+  function Stamp return Natural;
+
+end Atomic7_Pkg2;