[PATCH] ada: Do not capture global variables from elaboration code

[Samuel Tardieu <sam at rfc1149 dot net>]

Prevent GNAT from capturing library-level global variables in elaboration
code since it is clearly unsafe and may lead to incorrect code generation.

Regtested and i686-pc-linux-gnu.

    gcc/ada/
	PR ada/34287
	* sem_util.adb (Safe_To_Capture_Value): Do not capture values
	of variables declared in a library-level package.

    gcc/testsuite/gnat.dg/
	PR ada/34287
	* check_elaboration_code.adb: New test.

	* bug_elaboration_code.ads, bug_elaboration_code.adb: New support
	files.
---
 gcc/ada/sem_util.adb                             |   11 +++++++++++
 gcc/testsuite/gnat.dg/bug_elaboration_code.adb   |   12 ++++++++++++
 gcc/testsuite/gnat.dg/bug_elaboration_code.ads   |    8 ++++++++
 gcc/testsuite/gnat.dg/check_elaboration_code.adb |    9 +++++++++
 4 files changed, 40 insertions(+), 0 deletions(-)
 create mode 100644 gcc/testsuite/gnat.dg/bug_elaboration_code.adb
 create mode 100644 gcc/testsuite/gnat.dg/bug_elaboration_code.ads
 create mode 100644 gcc/testsuite/gnat.dg/check_elaboration_code.adb

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index a6c35d3..8dd4576 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8619,6 +8619,17 @@ package body Sem_Util is
          end loop;
       end;
 
+      --  It is never safe to capture the value of a variable declared
+      --  in a library level package. The code above will not have caught
+      --  it if we are currently analyzing elaboration code.
+
+      if (Ekind (Ent) = E_Variable and then No (Renamed_Object (Ent)))
+        and then Ekind (Scope (Ent)) = E_Package
+        and then Scope (Scope (Ent)) = Standard_Standard
+      then
+         return False;
+      end if;
+
       --  We also require that the reference does not appear in a context
       --  where it is not sure to be executed (i.e. a conditional context
       --  or an exception handler). We skip this if Cond is True, since the
diff --git a/gcc/testsuite/gnat.dg/bug_elaboration_code.adb b/gcc/testsuite/gnat.dg/bug_elaboration_code.adb
new file mode 100644
index 0000000..0aa7abe
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bug_elaboration_code.adb
@@ -0,0 +1,12 @@
+package body Bug_Elaboration_Code is
+
+   procedure Increment_I is
+   begin
+      I := I + 1;
+   end Increment_I;
+
+begin
+   I := 5;
+   Increment_I;
+   J := I;
+end Bug_Elaboration_Code;
diff --git a/gcc/testsuite/gnat.dg/bug_elaboration_code.ads b/gcc/testsuite/gnat.dg/bug_elaboration_code.ads
new file mode 100644
index 0000000..7354dcb
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bug_elaboration_code.ads
@@ -0,0 +1,8 @@
+package Bug_Elaboration_Code is
+
+   pragma Elaborate_Body;
+
+   I : Integer;
+   J : Integer;
+
+end Bug_Elaboration_Code;
diff --git a/gcc/testsuite/gnat.dg/check_elaboration_code.adb b/gcc/testsuite/gnat.dg/check_elaboration_code.adb
new file mode 100644
index 0000000..63dde56
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/check_elaboration_code.adb
@@ -0,0 +1,9 @@
+-- { dg-do run }
+with Bug_Elaboration_Code; use Bug_Elaboration_Code;
+
+procedure Check_Elaboration_Code is
+begin
+   if I /= J then
+      raise Program_Error;
+   end if;
+end Check_Elaboration_Code;
-- 
1.5.3.6