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

gcc/ada/ChangeLog

+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

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

gcc/testsuite/ChangeLog

+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>
 

gcc/testsuite/gnat.dg/decl_ctx_def.ads

+
+package DECL_CTX_Def is
+   X : exception;
+end;

gcc/testsuite/gnat.dg/decl_ctx_use.adb

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

gcc/testsuite/gnat.dg/decl_ctx_use.ads

+
+package DECL_CTX_Use is
+   procedure Check_1;
+   procedure Check_2;
+end;

gcc/testsuite/gnat.dg/tree_static_def.adb

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

gcc/testsuite/gnat.dg/tree_static_def.ads

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

gcc/testsuite/gnat.dg/tree_static_use.adb

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