Patchwork [Fortran] PR54884 - Fix TREE_PUBLIC()=0 regression for module procedures

login
register
mail settings
Submitter Tobias Burnus
Date Oct. 17, 2012, 10:02 a.m.
Message ID <507E8223.2020601@net-b.de>
Download mbox | patch
Permalink /patch/191996/
State New
Headers show

Comments

Tobias Burnus - Oct. 17, 2012, 10:02 a.m.
In GCC 4.8, module variables/procedures are marked as TREE_PUBLIC() if 
they are PRIVATE and not publicly visible used in PUBLIC procedures; the 
latter happens either via generic interfaces or via specification 
expressions. (The bug is old [early 4.8] but due to a recent follow up 
patch, the chance to run into this issue has increased.)

This patch adds the public_use attribute logic (also) to 
resolve_function, before it was only in resolve_symbol.

When doing so, I realized that it was also set for "other" as the 
specification_expr variable wasn't properly reset. I fixed that but I 
had also to add a few additional "specification_expr = true" as the 
current code only handled gfc_resolve_array_spec by chance.

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias
Paul Richard Thomas - Oct. 18, 2012, 3:26 p.m.
Hi Tobias,

The patch to fortran/cpp.c looks like a very worthy bit of
housekeeping but doesn't seem to me to have much to do with PR54844
:-)

The rest is fine and is OK for trunk.

Thanks for the fix.

Paul

On 17 October 2012 12:02, Tobias Burnus <burnus@net-b.de> wrote:
> In GCC 4.8, module variables/procedures are marked as TREE_PUBLIC() if they
> are PRIVATE and not publicly visible used in PUBLIC procedures; the latter
> happens either via generic interfaces or via specification expressions. (The
> bug is old [early 4.8] but due to a recent follow up patch, the chance to
> run into this issue has increased.)
>
> This patch adds the public_use attribute logic (also) to resolve_function,
> before it was only in resolve_symbol.
>
> When doing so, I realized that it was also set for "other" as the
> specification_expr variable wasn't properly reset. I fixed that but I had
> also to add a few additional "specification_expr = true" as the current code
> only handled gfc_resolve_array_spec by chance.
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
>
> Tobias
Paul Richard Thomas - Oct. 18, 2012, 5 p.m.
Hi Tobias,

The patch to fortran/cpp.c looks like a very worthy bit of
housekeeping but doesn't seem to me to have much to do with PR54844
:-)

The rest is fine and is OK for trunk.

Thanks for the fix.

Paul

On 17 October 2012 12:02, Tobias Burnus <burnus@net-b.de> wrote:
> In GCC 4.8, module variables/procedures are marked as TREE_PUBLIC() if they
> are PRIVATE and not publicly visible used in PUBLIC procedures; the latter
> happens either via generic interfaces or via specification expressions. (The
> bug is old [early 4.8] but due to a recent follow up patch, the chance to
> run into this issue has increased.)
>
> This patch adds the public_use attribute logic (also) to resolve_function,
> before it was only in resolve_symbol.
>
> When doing so, I realized that it was also set for "other" as the
> specification_expr variable wasn't properly reset. I fixed that but I had
> also to add a few additional "specification_expr = true" as the current code
> only handled gfc_resolve_array_spec by chance.
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
>
> Tobias

Patch

2012-10-17  Tobias Burnus  <burnus@net-b.de>

	PR fortran/54884
	* resolve.c (specification_expr): Change to bool.
	(resolve_formal_arglist, resolve_symbol): Set
	specification_expr to true before resolving the array spec.
	(resolve_variable, resolve_charlen, resolve_fl_variable):
	Properly reset specification_expr.
	(resolve_function): Set public_use when used in
	a specification expr.

2012-10-17  Tobias Burnus  <burnus@net-b.de>

	PR fortran/54884
	* gfortran.dg/public_private_module_7.f90: New.

diff --git a/gcc/fortran/cpp.c b/gcc/fortran/cpp.c
index c45af39..f54ba96 100644
--- a/gcc/fortran/cpp.c
+++ b/gcc/fortran/cpp.c
@@ -38,6 +38,10 @@  along with GCC; see the file COPYING3.  If not see
 #include "cppbuiltin.h"
 #include "mkdeps.h"
 
+#ifndef TARGET_SYSTEM_ROOT
+# define TARGET_SYSTEM_ROOT NULL
+#endif
+
 #ifndef TARGET_CPU_CPP_BUILTINS
 # define TARGET_CPU_CPP_BUILTINS()
 #endif
@@ -267,7 +271,7 @@  gfc_cpp_init_options (unsigned int decoded_options_count,
 
   gfc_cpp_option.multilib = NULL;
   gfc_cpp_option.prefix = NULL;
-  gfc_cpp_option.sysroot = NULL;
+  gfc_cpp_option.sysroot = TARGET_SYSTEM_ROOT;
 
   gfc_cpp_option.deferred_opt = XNEWVEC (gfc_cpp_deferred_opt_t,
 					 decoded_options_count);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 722e036..ac3021e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -81,7 +81,7 @@  static int omp_workshare_flag;
 static int formal_arg_flag = 0;
 
 /* True if we are resolving a specification expression.  */
-static int specification_expr = 0;
+static bool specification_expr = false;
 
 /* The id of the last entry seen.  */
 static int current_entry_id;
@@ -278,6 +278,7 @@  resolve_formal_arglist (gfc_symbol *proc)
 {
   gfc_formal_arglist *f;
   gfc_symbol *sym;
+  bool saved_specification_expr;
   int i;
 
   if (proc->result != NULL)
@@ -336,7 +337,10 @@  resolve_formal_arglist (gfc_symbol *proc)
       as = sym->ts.type == BT_CLASS && sym->attr.class_ok
 	   ? CLASS_DATA (sym)->as : sym->as;
 
+      saved_specification_expr = specification_expr;
+      specification_expr = true;
       gfc_resolve_array_spec (as, 0);
+      specification_expr = saved_specification_expr;
 
       /* We can't tell if an array with dimension (:) is assumed or deferred
 	 shape until we know if it has the pointer or allocatable attributes.
@@ -3119,6 +3123,12 @@  resolve_function (gfc_expr *expr)
       return FAILURE;
     }
 
+  if (sym && specification_expr && sym->attr.function
+      && gfc_current_ns->proc_name
+      && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
+    sym->attr.public_used = 1;
+
+
   /* Switch off assumed size checking and do this again for certain kinds
      of procedure, once the procedure itself is resolved.  */
   need_full_assumed_size++;
@@ -5368,7 +5378,7 @@  resolve_variable (gfc_expr *e)
       gfc_entry_list *entry;
       gfc_formal_arglist *formal;
       int n;
-      bool seen;
+      bool seen, saved_specification_expr;
 
       /* If the symbol is a dummy...  */
       if (sym->attr.dummy && sym->ns == gfc_current_ns)
@@ -5401,7 +5411,8 @@  resolve_variable (gfc_expr *e)
 	}
 
       /* Now do the same check on the specification expressions.  */
-      specification_expr = 1;
+      saved_specification_expr = specification_expr;
+      specification_expr = true;
       if (sym->ts.type == BT_CHARACTER
 	  && gfc_resolve_expr (sym->ts.u.cl->length) == FAILURE)
 	t = FAILURE;
@@ -5409,14 +5420,12 @@  resolve_variable (gfc_expr *e)
       if (sym->as)
 	for (n = 0; n < sym->as->rank; n++)
 	  {
-	     specification_expr = 1;
 	     if (gfc_resolve_expr (sym->as->lower[n]) == FAILURE)
 	       t = FAILURE;
-	     specification_expr = 1;
 	     if (gfc_resolve_expr (sym->as->upper[n]) == FAILURE)
 	       t = FAILURE;
 	  }
-      specification_expr = 0;
+      specification_expr = saved_specification_expr;
 
       if (t == SUCCESS)
 	/* Update the symbol's entry level.  */
@@ -10175,28 +10184,35 @@  static gfc_try
 resolve_charlen (gfc_charlen *cl)
 {
   int i, k;
+  bool saved_specification_expr;
 
   if (cl->resolved)
     return SUCCESS;
 
   cl->resolved = 1;
-
+  saved_specification_expr = specification_expr;
+  specification_expr = true;
 
   if (cl->length_from_typespec)
     {
       if (gfc_resolve_expr (cl->length) == FAILURE)
-	return FAILURE;
+	{
+	  specification_expr = saved_specification_expr;
+	  return FAILURE;
+	}
 
       if (gfc_simplify_expr (cl->length, 0) == FAILURE)
-	return FAILURE;
+	{
+	  specification_expr = saved_specification_expr;
+	  return FAILURE;
+	}
     }
   else
     {
-      specification_expr = 1;
 
       if (resolve_index_expr (cl->length) == FAILURE)
 	{
-	  specification_expr = 0;
+	  specification_expr = saved_specification_expr;
 	  return FAILURE;
 	}
     }
@@ -10220,9 +10236,11 @@  resolve_charlen (gfc_charlen *cl)
       && mpz_cmp (cl->length->value.integer, gfc_integer_kinds[k].huge) > 0)
     {
       gfc_error ("String length at %L is too large", &cl->length->where);
+      specification_expr = saved_specification_expr;
       return FAILURE;
     }
 
+  specification_expr = saved_specification_expr;
   return SUCCESS;
 }
 
@@ -10682,6 +10700,7 @@  resolve_fl_variable (gfc_symbol *sym, int mp_flag)
   int no_init_flag, automatic_flag;
   gfc_expr *e;
   const char *auto_save_msg;
+  bool saved_specification_expr;
 
   auto_save_msg = "Automatic object '%s' at %L cannot have the "
 		  "SAVE attribute";
@@ -10692,7 +10711,8 @@  resolve_fl_variable (gfc_symbol *sym, int mp_flag)
   /* Set this flag to check that variables are parameters of all entries.
      This check is effected by the call to gfc_resolve_expr through
      is_non_constant_shape_array.  */
-  specification_expr = 1;
+  saved_specification_expr = specification_expr;
+  specification_expr = true;
 
   if (sym->ns->proc_name
       && (sym->ns->proc_name->attr.flavor == FL_MODULE
@@ -10706,7 +10726,7 @@  resolve_fl_variable (gfc_symbol *sym, int mp_flag)
 	 constant.  */
       gfc_error ("The module or main program array '%s' at %L must "
 		 "have constant shape", sym->name, &sym->declared_at);
-      specification_expr = 0;
+      specification_expr = saved_specification_expr;
       return FAILURE;
     }
 
@@ -10716,6 +10736,7 @@  resolve_fl_variable (gfc_symbol *sym, int mp_flag)
       gfc_error ("Entity '%s' at %L has a deferred type parameter and "
 		 "requires either the pointer or allocatable attribute",
 		     sym->name, &sym->declared_at);
+      specification_expr = saved_specification_expr;
       return FAILURE;
     }
 
@@ -10729,12 +10750,14 @@  resolve_fl_variable (gfc_symbol *sym, int mp_flag)
 	{
 	  gfc_error ("Entity with assumed character length at %L must be a "
 		     "dummy argument or a PARAMETER", &sym->declared_at);
+	  specification_expr = saved_specification_expr;
 	  return FAILURE;
 	}
 
       if (e && sym->attr.save == SAVE_EXPLICIT && !gfc_is_constant_expr (e))
 	{
 	  gfc_error (auto_save_msg, sym->name, &sym->declared_at);
+	  specification_expr = saved_specification_expr;
 	  return FAILURE;
 	}
 
@@ -10748,12 +10771,14 @@  resolve_fl_variable (gfc_symbol *sym, int mp_flag)
 	    {
 	      gfc_error ("'%s' at %L must have constant character length "
 			"in this context", sym->name, &sym->declared_at);
+	      specification_expr = saved_specification_expr;
 	      return FAILURE;
 	    }
 	  if (sym->attr.in_common)
 	    {
 	      gfc_error ("COMMON variable '%s' at %L must have constant "
 			 "character length", sym->name, &sym->declared_at);
+	      specification_expr = saved_specification_expr;
 	      return FAILURE;
 	    }
 	}
@@ -10784,6 +10809,7 @@  resolve_fl_variable (gfc_symbol *sym, int mp_flag)
       if (automatic_flag && sym->attr.save == SAVE_EXPLICIT)
 	{
 	  gfc_error (auto_save_msg, sym->name, &sym->declared_at);
+	  specification_expr = saved_specification_expr;
 	  return FAILURE;
 	}
     }
@@ -10817,13 +10843,19 @@  resolve_fl_variable (gfc_symbol *sym, int mp_flag)
 		   sym->name, &sym->declared_at);
       else
 	goto no_init_error;
+      specification_expr = saved_specification_expr;
       return FAILURE;
     }
 
 no_init_error:
   if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
-    return resolve_fl_variable_derived (sym, no_init_flag);
+    {
+      gfc_try res = resolve_fl_variable_derived (sym, no_init_flag);
+      specification_expr = saved_specification_expr;
+      return res;
+    }
 
+  specification_expr = saved_specification_expr;
   return SUCCESS;
 }
 
@@ -12569,6 +12601,7 @@  resolve_symbol (gfc_symbol *sym)
   gfc_component *c;
   symbol_attribute class_attr;
   gfc_array_spec *as;
+  bool saved_specification_expr;
 
   if (sym->attr.artificial)
     return;
@@ -12689,7 +12722,12 @@  resolve_symbol (gfc_symbol *sym)
 	}
     }
   else if (mp_flag && sym->attr.flavor == FL_PROCEDURE && sym->attr.function)
-    gfc_resolve_array_spec (sym->result->as, false);
+    {
+      bool saved_specification_expr = specification_expr;
+      specification_expr = true;
+      gfc_resolve_array_spec (sym->result->as, false);
+      specification_expr = saved_specification_expr;
+    }
 
   if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
     {
@@ -13105,7 +13143,10 @@  resolve_symbol (gfc_symbol *sym)
   if (sym->attr.function && sym->as)
     formal_arg_flag = 1;
 
+  saved_specification_expr = specification_expr;
+  specification_expr = true;
   gfc_resolve_array_spec (sym->as, check_constant);
+  specification_expr = saved_specification_expr;
 
   formal_arg_flag = 0;
 
--- /dev/null	2012-10-14 08:57:40.159727696 +0200
+++ gcc/gcc/testsuite/gfortran.dg/public_private_module_7.f90	2012-10-17 00:15:53.000000000 +0200
@@ -0,0 +1,29 @@ 
+! { dg-do compile }
+! { dg-options "-O2" }
+!
+! PR fortran/54884
+!
+! Check that get_key_len is not optimized away as it
+! is used in a publicly visible specification expression.
+!
+module m_common_attrs
+  private
+  !...
+  public :: get_key
+contains
+  pure function get_key_len() result(n)
+    n = 5
+  end function get_key_len
+  pure function other() result(n)
+    n = 5
+  end function other
+  ! ...
+  function get_key() result(key)
+    ! ...
+    character(len=get_key_len()) :: key
+    key = ''
+  end function get_key
+end module m_common_attrs
+
+! { dg-final { scan-assembler-not "__m_common_attrs_MOD_other" } }
+! { dg-final { scan-assembler "__m_common_attrs_MOD_get_key_len" } }