re PR fortran/86248 (LEN_TRIM in specification expression causes link failure)
2019-10-27 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-27 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. From-SVN: r277487
This commit is contained in:
parent
051d8a5faa
commit
a9b64a6154
@ -1,3 +1,15 @@
|
||||
2019-10-27 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-25 Cesar Philippidis <cesar@codesourcery.com>
|
||||
Tobias Burnus <tobias@codesourcery.com>
|
||||
|
||||
@ -23,7 +35,7 @@
|
||||
|
||||
PR fortran/92174
|
||||
* decl.c (attr_decl1): Move check for F2018:C822 from here ...
|
||||
* array.c (gfc_set_array_spec): ... to here.
|
||||
* array.c (gfc_set_array_spec): ... to here.
|
||||
|
||||
2019-10-18 Steven G. Kargl <kargl@gcc.gnu.org>
|
||||
|
||||
|
@ -16777,8 +16777,8 @@ resolve_equivalence (gfc_equiv *eq)
|
||||
}
|
||||
|
||||
|
||||
/* Function called by resolve_fntype to flag other symbol used in the
|
||||
length type parameter specification of function resuls. */
|
||||
/* 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,
|
||||
|
@ -369,44 +369,37 @@ gfc_sym_identifier (gfc_symbol * sym)
|
||||
static const char *
|
||||
mangled_identifier (gfc_symbol *sym)
|
||||
{
|
||||
static char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
|
||||
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)
|
||||
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);
|
||||
return name;
|
||||
}
|
||||
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
|
||||
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;
|
||||
}
|
||||
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",
|
||||
sym->ns->proc_name->name, sym->name);
|
||||
return name;
|
||||
}
|
||||
snprintf (name, sizeof name, "__%s_PROC_%s",
|
||||
proc->name, sym->name);
|
||||
}
|
||||
|
||||
return name;
|
||||
}
|
||||
|
||||
/* Get mangled identifier, adding the symbol to the global table if
|
||||
|
@ -1,3 +1,9 @@
|
||||
2019-10-27 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.
|
||||
|
||||
2019-10-26 Hongtao Liu <hongtao.liu@intel.com>
|
||||
|
||||
PR target/89071
|
||||
|
24
gcc/testsuite/gfortran.dg/char_result_19.f90
Normal file
24
gcc/testsuite/gfortran.dg/char_result_19.f90
Normal file
@ -0,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
|
18
gcc/testsuite/gfortran.dg/char_result_mod_19.f90
Normal file
18
gcc/testsuite/gfortran.dg/char_result_mod_19.f90
Normal file
@ -0,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
|
Loading…
Reference in New Issue
Block a user