From a7a46bb2d96c538337c19f5ba9bb55fb7b34c726 Mon Sep 17 00:00:00 2001 From: Olivier Hainque Date: Thu, 17 Jul 2008 14:18:27 +0000 Subject: [PATCH] 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 | 7 +++++++ gcc/ada/utils.c | 16 +++++++++------- gcc/testsuite/ChangeLog | 7 +++++++ gcc/testsuite/gnat.dg/decl_ctx_def.ads | 4 ++++ gcc/testsuite/gnat.dg/decl_ctx_use.adb | 14 ++++++++++++++ gcc/testsuite/gnat.dg/decl_ctx_use.ads | 5 +++++ gcc/testsuite/gnat.dg/tree_static_def.adb | 11 +++++++++++ gcc/testsuite/gnat.dg/tree_static_def.ads | 10 ++++++++++ gcc/testsuite/gnat.dg/tree_static_use.adb | 12 ++++++++++++ 9 files changed, 79 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/decl_ctx_def.ads create mode 100644 gcc/testsuite/gnat.dg/decl_ctx_use.adb create mode 100644 gcc/testsuite/gnat.dg/decl_ctx_use.ads create mode 100644 gcc/testsuite/gnat.dg/tree_static_def.adb create mode 100644 gcc/testsuite/gnat.dg/tree_static_def.ads create mode 100644 gcc/testsuite/gnat.dg/tree_static_use.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 92f6d7b..696e9d1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2008-07-17 Olivier Hainque + + * 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 PR documentation/15479 diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 92e8348..2782559 100644 --- 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 55d0839..e5cd6a3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2008-07-17 Olivier Hainque + + * 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 Mark Mitchell diff --git a/gcc/testsuite/gnat.dg/decl_ctx_def.ads b/gcc/testsuite/gnat.dg/decl_ctx_def.ads new file mode 100644 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 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 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 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 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 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; + + -- 2.7.4