re PR fortran/44265 (Link error with reference to parameter array in specification expression)

2016-12-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/44265
	* gfortran.h : Add fn_result_spec bitfield to gfc_symbol.
	* resolve.c (flag_fn_result_spec): New function.
	(resolve_fntype): Call it for character result lengths.
	* symbol.c (gfc_new_symbol): Set fn_result_spec to zero.
	* trans-decl.c (gfc_sym_mangled_identifier): Include the
	procedure name in the mangled name for symbols with the
	fn_result_spec bit set.
	(gfc_finish_var_decl): Mark the decls of these symbols
	appropriately for the case where the function is external.
	(gfc_get_symbol_decl): Mangle the name of these symbols.
	(gfc_create_module_variable): Allow them through the assert.
	(gfc_generate_function_code): Remove the assert before the
	initialization of sym->tlink because the frontend no longer
	uses this field.
	* trans-expr.c (gfc_map_intrinsic_function): Add a case to
	treat the LEN_TRIM intrinsic.
	(gfc_trans_string_copy): Deal with Wstringop-overflow warning
	that can occur with constant source lengths at -O3.

2016-12-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/44265
	* gfortran.dg/char_result_14.f90: New test.
	* gfortran.dg/char_result_15.f90: New test.

From-SVN: r243478

1 files changed, 59 insertions, 0 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e4ea10f..2093de9 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -566,6 +566,14 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns)
 {
   bool t;
 
+  if (sym && sym->attr.flavor == FL_PROCEDURE
+      && sym->ns->parent
+      && sym->ns->parent->proc_name
+      && sym->ns->parent->proc_name->attr.flavor == FL_PROCEDURE
+      && !strcmp (sym->name, sym->ns->parent->proc_name->name))
+    gfc_error ("Contained procedure %qs at %L has the same name as its "
+	       "encompassing procedure", sym->name, &sym->declared_at);
+
   /* If this namespace is not a function or an entry master function,
      ignore it.  */
   if (! sym || !(sym->attr.function || sym->attr.flavor == FL_VARIABLE)
@@ -15747,6 +15755,54 @@ resolve_equivalence (gfc_equiv *eq)
 }
 
 
+/* Function called by resolve_fntype to flag other symbol used in the
+   length type parameter specification of function resuls.  */
+
+static bool
+flag_fn_result_spec (gfc_expr *expr,
+                     gfc_symbol *sym ATTRIBUTE_UNUSED,
+                     int *f ATTRIBUTE_UNUSED)
+{
+  gfc_namespace *ns;
+  gfc_symbol *s;
+
+  if (expr->expr_type == EXPR_VARIABLE)
+    {
+      s = expr->symtree->n.sym;
+      for (ns = s->ns; ns; ns = ns->parent)
+	if (!ns->parent)
+	  break;
+
+      if (!s->fn_result_spec
+	  && s->attr.flavor == FL_PARAMETER)
+	{
+	  /* Function contained in a module.... */
+	  if (ns->proc_name && ns->proc_name->attr.flavor == FL_MODULE)
+	    {
+	      gfc_symtree *st;
+	      s->fn_result_spec = 1;
+	      /* Make sure that this symbol is translated as a module
+		 variable.  */
+	      st = gfc_get_unique_symtree (ns);
+	      st->n.sym = s;
+	      s->refs++;
+	    }
+	  /* ... which is use associated and called.  */
+	  else if (s->attr.use_assoc || s->attr.used_in_submodule
+			||
+		  /* External function matched with an interface.  */
+		  (s->ns->proc_name
+		   && ((s->ns == ns
+			 && s->ns->proc_name->attr.if_source == IFSRC_DECL)
+		       || s->ns->proc_name->attr.if_source == IFSRC_IFBODY)
+		   && s->ns->proc_name->attr.function))
+	    s->fn_result_spec = 1;
+	}
+    }
+  return false;
+}
+
+
 /* Resolve function and ENTRY types, issue diagnostics if needed.  */
 
 static void
@@ -15797,6 +15853,9 @@ resolve_fntype (gfc_namespace *ns)
 	    el->sym->attr.untyped = 1;
 	  }
       }
+
+  if (sym->ts.type == BT_CHARACTER)
+    gfc_traverse_expr (sym->ts.u.cl->length, NULL, flag_fn_result_spec, 0);
 }