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 <pa...@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 <pa...@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 <lo...@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