Commit a7a46bb2 by Olivier Hainque Committed by Olivier Hainque

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
parent 711b2998
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> 2008-07-14 Ralf Wildenhues <Ralf.Wildenhues@gmx.de>
PR documentation/15479 PR documentation/15479
...@@ -418,9 +418,11 @@ gnat_poplevel () ...@@ -418,9 +418,11 @@ gnat_poplevel ()
void void
gnat_pushdecl (tree decl, Node_Id gnat_node) gnat_pushdecl (tree decl, Node_Id gnat_node)
{ {
/* If at top level, there is no context. But PARM_DECLs always go in the /* If this decl is public external or at toplevel, there is no context.
level of its function. */ But PARM_DECLs always go in the level of its function. */
if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL) if (TREE_CODE (decl) != PARM_DECL
&& ((DECL_EXTERNAL (decl) && TREE_PUBLIC (decl))
|| global_bindings_p ()))
DECL_CONTEXT (decl) = 0; DECL_CONTEXT (decl) = 0;
else else
{ {
...@@ -1471,9 +1473,9 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list, ...@@ -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 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. 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 PUBLIC_FLAG is true if this is for a reference to a public entity or for a
the current compilation unit. This flag should be set when processing the definition to be made visible outside of the current compilation unit, for
variable definitions in a package specification. instance variable definitions in a package specification.
EXTERN_FLAG is nonzero when processing an external variable declaration (as EXTERN_FLAG is nonzero when processing an external variable declaration (as
opposed to a definition: no storage is to be allocated for the variable). 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, ...@@ -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 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. */ we allocate automatic storage unless requested not to. */
TREE_STATIC (var_decl) 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)) if (asm_name && VAR_OR_FUNCTION_DECL_P (var_decl))
SET_DECL_ASSEMBLER_NAME (var_decl, asm_name); SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
......
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> 2008-07-17 Julian Brown <julian@codesourcery.com>
Mark Mitchell <mark@codesourcery.com> Mark Mitchell <mark@codesourcery.com>
......
package DECL_CTX_Def is
X : exception;
end;
-- { 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;
package DECL_CTX_Use is
procedure Check_1;
procedure Check_2;
end;
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;
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;
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment