re PR ada/34287 (Simple Ada bug [Barnes' Silly])

2007-12-03  Robert Dewar <dewar@adacore.com>
            Samuel Tardieu  <sam@rfc1149.net>

        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.

Co-Authored-By: Samuel Tardieu <sam@rfc1149.net>

From-SVN: r130582

6 files changed, 50 insertions, 1 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4d1fa5b2..54f3d5c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2007-12-03  Robert Dewar <dewar@adacore.com>
+            Samuel Tardieu  <sam@rfc1149.net>
+
+    	PR ada/34287
+    	* sem_util.adb (Safe_To_Capture_Value): Do not capture values
+    	of variables declared in a library-level package.
+    
 2007-12-02  Samuel Tardieu  <sam@rfc1149.net>
 
 	* clean.adb (Clean_Library_Directory): Use Empty_String'Access intead
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index a6c35d3..600a7bf 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8583,12 +8583,16 @@ package body Sem_Util is
 
       --  Skip if volatile or aliased, since funny things might be going on in
       --  these cases which we cannot necessarily track. Also skip any variable
-      --  for which an address clause is given, or whose address is taken.
+      --  for which an address clause is given, or whose address is taken. Also
+      --  never capture value of library level variables (an attempt to do so
+      --  can occur in the case of package elaboration code).
 
       if Treat_As_Volatile (Ent)
         or else Is_Aliased (Ent)
         or else Present (Address_Clause (Ent))
         or else Address_Taken (Ent)
+        or else (Is_Library_Level_Entity (Ent)
+                   and then Ekind (Ent) = E_Variable)
       then
          return False;
       end if;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 99fea62..2dd999b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+2007-12-03  Robert Dewar <dewar@adacore.com>
+            Samuel Tardieu  <sam@rfc1149.net>
+
+    	PR ada/34287
+    	* check_elaboration_code.adb: New test.
+    
+    	* bug_elaboration_code.ads, bug_elaboration_code.adb: New support
+    	files.
+
 2007-12-02  Paolo Carlini  <pcarlini@suse.de>
 
         PR c++/34061
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;