utils.c (create_var_decl_1): Relax expectations on the PUBLIC_FLAG argument...

	ada/
	* utils.c (create_var_decl_1): Relax expectations on the PUBLIC_FLAG
	argument, to apply to references in addition to definitions.  Prevent
	setting TREE_STATIC on externals.
	(gnat_pushdecl): Always clear DECL_CONTEXT on public externals.

	testsuite/
	* gnat.dg/tree_static_def.ad[bs]: Support for ...
	* gnat.dg/tree_static_use.adb: New test.
	* gnat.dg/decl_ctx_def.ads: Support for ...
	* gnat.dg/decl_ctx_use.ad[bs]: New test.

From-SVN: r137923

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 92f6d7bb16de39de60b0f91b938ca3eab3917f87..696e9d1423c5d31bff75b9368086f64895b39d49 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2008-07-17  Olivier Hainque  <hainque@adacore.com>
+
+       * utils.c (create_var_decl_1): Relax expectations on the PUBLIC_FLAG
+       argument, to apply to references in addition to definitions.  Prevent
+       setting TREE_STATIC on externals.
+       (gnat_pushdecl): Always clear DECL_CONTEXT on public externals.
+
 2008-07-14  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
 
        PR documentation/15479

diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c
index 92e83487b80eae9b9159d86bd09a1c0ee4b0a736..278255958856f1455d9328be3b3e6a722f030b73 100644 (file)
--- a/gcc/ada/utils.c
+++ b/gcc/ada/utils.c
@@ -418,9 +418,11 @@ gnat_poplevel ()
 void
 gnat_pushdecl (tree decl, Node_Id gnat_node)
 {
-  /* If at top level, there is no context. But PARM_DECLs always go in the
-     level of its function.  */
-  if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL)
+  /* If this decl is public external or at toplevel, there is no context.
+     But PARM_DECLs always go in the level of its function.  */
+  if (TREE_CODE (decl) != PARM_DECL
+      && ((DECL_EXTERNAL (decl) && TREE_PUBLIC (decl))
+         || global_bindings_p ()))
     DECL_CONTEXT (decl) = 0;
   else
     {
@@ -1471,9 +1473,9 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
    CONST_FLAG is true if this variable is constant, in which case we might
    return a CONST_DECL node unless CONST_DECL_ALLOWED_P is false.
 
-   PUBLIC_FLAG is true if this definition is to be made visible outside of
-   the current compilation unit. This flag should be set when processing the
-   variable definitions in a package specification.
+   PUBLIC_FLAG is true if this is for a reference to a public entity or for a
+   definition to be made visible outside of the current compilation unit, for
+   instance variable definitions in a package specification.
 
    EXTERN_FLAG is nonzero when processing an external variable declaration (as
    opposed to a definition: no storage is to be allocated for the variable).
@@ -1549,7 +1551,7 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
      variable if and only if it's not external. If we are not at the top level
      we allocate automatic storage unless requested not to.  */
   TREE_STATIC (var_decl)
-    = public_flag || (global_bindings_p () ? !extern_flag : static_flag);
+    = !extern_flag && (public_flag || static_flag || global_bindings_p ());
 
   if (asm_name && VAR_OR_FUNCTION_DECL_P (var_decl))
     SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 55d0839c1838d1c0adb57059b99b8aca4ae3a75b..e5cd6a37c175eb9aa055b6326cd294f93a718c76 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2008-07-17  Olivier Hainque  <hainque@adacore.com>
+
+       * gnat.dg/tree_static_def.ad[bs]: Support for ...
+       * gnat.dg/tree_static_use.adb: New test.
+       * gnat.dg/decl_ctx_def.ads: Support for ...
+       * gnat.dg/decl_ctx_use.ad[bs]: New test.
+
 2008-07-17  Julian Brown  <julian@codesourcery.com>
            Mark Mitchell  <mark@codesourcery.com>
 

diff --git a/gcc/testsuite/gnat.dg/decl_ctx_def.ads b/gcc/testsuite/gnat.dg/decl_ctx_def.ads
new file mode 100644 (file)
index 0000000..dd004df
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/decl_ctx_def.ads
@@ -0,0 +1,4 @@
+
+package DECL_CTX_Def is
+   X : exception;
+end;

diff --git a/gcc/testsuite/gnat.dg/decl_ctx_use.adb b/gcc/testsuite/gnat.dg/decl_ctx_use.adb
new file mode 100644 (file)
index 0000000..c4fde2b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/decl_ctx_use.adb
@@ -0,0 +1,14 @@
+-- { dg-do compile }
+-- { dg-options "-O1" }
+with DECL_CTX_Def; use DECL_CTX_Def;
+package body DECL_CTX_Use is
+   procedure Check_1 is
+   begin
+      raise X;
+   end;
+
+   procedure Check_2 is
+   begin
+      raise X;
+   end;
+end;

diff --git a/gcc/testsuite/gnat.dg/decl_ctx_use.ads b/gcc/testsuite/gnat.dg/decl_ctx_use.ads
new file mode 100644 (file)
index 0000000..2f38f89
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/decl_ctx_use.ads
@@ -0,0 +1,5 @@
+
+package DECL_CTX_Use is
+   procedure Check_1;
+   procedure Check_2;
+end;

diff --git a/gcc/testsuite/gnat.dg/tree_static_def.adb b/gcc/testsuite/gnat.dg/tree_static_def.adb
new file mode 100644 (file)
index 0000000..ed86747
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/tree_static_def.adb
@@ -0,0 +1,11 @@
+
+package body TREE_STATIC_Def is
+
+ procedure check (i : int; v : integer) is
+ begin
+    if i.value /= v then
+      raise program_error;
+    end if;
+ end;
+end;
+

diff --git a/gcc/testsuite/gnat.dg/tree_static_def.ads b/gcc/testsuite/gnat.dg/tree_static_def.ads
new file mode 100644 (file)
index 0000000..1ea58ee
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/tree_static_def.ads
@@ -0,0 +1,10 @@
+package TREE_STATIC_Def is
+
+   type Int is record
+      Value : Integer;
+   end record;
+
+   procedure check (I : Int; v : integer);
+
+   One : constant Int := (Value => 1);
+end;

diff --git a/gcc/testsuite/gnat.dg/tree_static_use.adb b/gcc/testsuite/gnat.dg/tree_static_use.adb
new file mode 100644 (file)
index 0000000..ff02b54
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/tree_static_use.adb
@@ -0,0 +1,12 @@
+-- { dg-do run }
+-- { dg-options "-O1" }
+
+with TREE_STATIC_Def; use TREE_STATIC_Def;
+
+procedure TREE_STATIC_Use is
+   I : Int := One;
+begin
+   check (I, 1);
+end;
+
+