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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@243478 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 45 insertions, 9 deletions

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 2e6ef2a2bfc..f659a486ec9 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -356,12 +356,36 @@ gfc_sym_mangled_identifier (gfc_symbol * sym)
   if (sym->attr.is_bind_c == 1 && sym->binding_label)
     return get_identifier (sym->binding_label);
 
-  if (sym->module == NULL)
-    return gfc_sym_identifier (sym);
+  if (!sym->fn_result_spec)
+    {
+      if (sym->module == NULL)
+	return gfc_sym_identifier (sym);
+      else
+	{
+	  snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
+	  return get_identifier (name);
+	}
+    }
   else
     {
-      snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
-      return get_identifier (name);
+      /* This is an entity that is actually local to a module procedure
+	 that appears in the result specification expression.  Since
+	 sym->module will be a zero length string, we use ns->proc_name
+	 instead. */
+      if (sym->ns->proc_name && sym->ns->proc_name->module)
+	{
+	  snprintf (name, sizeof name, "__%s_MOD__%s_PROC_%s",
+		    sym->ns->proc_name->module,
+		    sym->ns->proc_name->name,
+		    sym->name);
+	  return get_identifier (name);
+	}
+      else
+	{
+	  snprintf (name, sizeof name, "__%s_PROC_%s",
+		    sym->ns->proc_name->name, sym->name);
+	  return get_identifier (name);
+	}
     }
 }
 
@@ -615,6 +639,16 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
       DECL_EXTERNAL (decl) = 1;
       TREE_PUBLIC (decl) = 1;
     }
+  else if (sym->fn_result_spec && !sym->ns->proc_name->module)
+    {
+
+      if (sym->ns->proc_name->attr.if_source != IFSRC_DECL)
+	DECL_EXTERNAL (decl) = 1;
+      else
+	TREE_STATIC (decl) = 1;
+
+      TREE_PUBLIC (decl) = 1;
+    }
   else if (sym->module && !sym->attr.result && !sym->attr.dummy)
     {
       /* TODO: Don't set sym->module for result or dummy variables.  */
@@ -1632,7 +1666,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   /* Create string length decl first so that they can be used in the
      type declaration.  For associate names, the target character
      length is used. Set 'length' to a constant so that if the
-     string lenght is a variable, it is not finished a second time.  */
+     string length is a variable, it is not finished a second time.  */
   if (sym->ts.type == BT_CHARACTER)
     {
       if (sym->attr.associate_var
@@ -1654,7 +1688,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   /* Symbols from modules should have their assembler names mangled.
      This is done here rather than in gfc_finish_var_decl because it
      is different for string length variables.  */
-  if (sym->module)
+  if (sym->module || sym->fn_result_spec)
     {
       gfc_set_decl_assembler_name (decl, gfc_sym_mangled_identifier (sym));
       if (sym->attr.use_assoc && !intrinsic_array_parameter)
@@ -4766,7 +4800,9 @@ gfc_create_module_variable (gfc_symbol * sym)
 
   /* Create the variable.  */
   pushdecl (decl);
-  gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE);
+  gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE
+	      || (sym->ns->parent->proc_name->attr.flavor == FL_MODULE
+		  && sym->fn_result_spec));
   DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl;
   rest_of_decl_compilation (decl, 1, 0);
   gfc_module_add_decl (cur_module, decl);
@@ -6153,8 +6189,8 @@ gfc_generate_function_code (gfc_namespace * ns)
   previous_procedure_symbol = current_procedure_symbol;
   current_procedure_symbol = sym;
 
-  /* Check that the frontend isn't still using this.  */
-  gcc_assert (sym->tlink == NULL);
+  /* Initialize sym->tlink so that gfc_trans_deferred_vars does not get
+     lost or worse.  */
   sym->tlink = sym;
 
   /* Create the declaration for functions with global scope.  */