===================================================================
*************** 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,
}
! /* 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,
===================================================================
*************** gfc_sym_identifier (gfc_symbol * sym)
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
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
===================================================================
***************
+ ! { 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
===================================================================
***************
+ ! { 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