[Patch, fortran] PR86248 - [7/8/9/10 Regression] LEN_TRIM in specification expression causes link failure

[Paul Richard Thomas <paul dot richard dot thomas at gmail dot com>]

As far as I can tell, this is a 6-regression as well - ***sigh***

The patch is fundamentally very simple. Symbols that were marked with
the fn_result_spec flag that really were module parameters were having
the wrong name mangling applied to them. The rest of the patch is a
tidy up.

Regtested on FC30/x86_64 - OK for all the branches after a bedding in
period on trunk?

Cheers

Paul

2019-10-26  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/86248
    * resolve.c (flag_fn_result_spec): Correct a typo before the
    function declaration.
    * trans-decl.c (gfc_sym_identifier): Boost the length of 'name'
    to allow for all variants. Simplify the code by using a pointer
    to the symbol's proc_name and taking the return out of each of
    the conditional branches. Allow symbols with fn_result_spec set
    that do not come from a procedure namespace and have a module
    name to go through the non-fn_result_spec branch.

2019-10-26  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/86248
    * gfortran.dg/char_result_19.f90 : New test.
    * gfortran.dg/char_result_mod_19.f90 : Module for the new test.

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 277203)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_equivalence (gfc_equiv *eq)
*** 16774,16781 ****
  }
  
  
! /* 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,
--- 16774,16781 ----
  }
  
  
! /* Function called by resolve_fntype to flag other symbols used in the
!    length type parameter specification of function results.  */
  
  static bool
  flag_fn_result_spec (gfc_expr *expr,
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c	(revision 277203)
--- gcc/fortran/trans-decl.c	(working copy)
*************** gfc_sym_identifier (gfc_symbol * sym)
*** 369,412 ****
  static const char *
  mangled_identifier (gfc_symbol *sym)
  {
!   static char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
    /* Prevent the mangling of identifiers that have an assigned
       binding label (mainly those that are bind(c)).  */
  
    if (sym->attr.is_bind_c == 1 && sym->binding_label)
      return sym->binding_label;
  
!   if (!sym->fn_result_spec)
      {
        if (sym->module == NULL)
  	return sym_identifier (sym);
        else
! 	{
! 	  snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
! 	  return name;
! 	}
      }
    else
      {
        /* 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 name;
! 	}
        else
! 	{
! 	  snprintf (name, sizeof name, "__%s_PROC_%s",
! 		    sym->ns->proc_name->name, sym->name);
! 	  return name;
! 	}
      }
  }
  
  /* Get mangled identifier, adding the symbol to the global table if
--- 369,405 ----
  static const char *
  mangled_identifier (gfc_symbol *sym)
  {
!   gfc_symbol *proc = sym->ns->proc_name;
!   static char name[3*GFC_MAX_MANGLED_SYMBOL_LEN + 14];
    /* Prevent the mangling of identifiers that have an assigned
       binding label (mainly those that are bind(c)).  */
  
    if (sym->attr.is_bind_c == 1 && sym->binding_label)
      return sym->binding_label;
  
!   if (!sym->fn_result_spec
!       || (sym->module && !(proc && proc->attr.flavor == FL_PROCEDURE)))
      {
        if (sym->module == NULL)
  	return sym_identifier (sym);
        else
! 	snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
      }
    else
      {
        /* 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
! 	 to provide the module name instead. */
!       if (proc && proc->module)
! 	snprintf (name, sizeof name, "__%s_MOD__%s_PROC_%s",
! 		  proc->module, proc->name, sym->name);
        else
! 	snprintf (name, sizeof name, "__%s_PROC_%s",
! 		  proc->name, sym->name);
      }
+ 
+   return name;
  }
  
  /* Get mangled identifier, adding the symbol to the global table if
Index: gcc/testsuite/gfortran.dg/char_result_19.f90
===================================================================
*** gcc/testsuite/gfortran.dg/char_result_19.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/char_result_19.f90	(working copy)
***************
*** 0 ****
--- 1,24 ----
+ ! { dg-do preprocess }
+ ! { dg-additional-options "-cpp" }
+ !
+ ! Test the fix for PR86248
+ !
+ ! Contributed by Bill Long  <longb@cray.com>
+ !
+ program test
+   use test_module
+   implicit none
+   integer :: i
+   character(:), allocatable :: chr
+   do i = 0, 2
+     chr = func_1 (i)
+     select case (i)
+       case (0)
+         if (chr .ne. 'el0') stop i
+       case (1)
+         if (chr .ne. 'el11') stop i
+       case (2)
+         if (chr .ne. 'el2') stop i
+     end select
+   end do
+ end program test
Index: gcc/testsuite/gfortran.dg/char_result_mod_19.f90
===================================================================
*** gcc/testsuite/gfortran.dg/char_result_mod_19.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/char_result_mod_19.f90	(working copy)
***************
*** 0 ****
--- 1,18 ----
+ ! { dg-do  run }
+ ! { dg-additional-sources char_result_19.f90 }
+ !
+ ! Module for char_result_19.f90
+ ! Tests fix for PR86248
+ !
+ module test_module
+   implicit none
+   public :: func_1
+   private
+   character(len=*),dimension(0:2),parameter :: darray = (/"el0 ","el11","el2 "/)
+ contains
+   function func_1 (func_1_input) result(f)
+     integer, intent(in) :: func_1_input
+     character(len = len_trim (darray(func_1_input))) :: f
+     f = darray(func_1_input)
+   end function func_1
+ end module test_module