Commit a9b64a61 by Paul Thomas

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
parent 051d8a5f
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> 2019-10-25 Cesar Philippidis <cesar@codesourcery.com>
Tobias Burnus <tobias@codesourcery.com> Tobias Burnus <tobias@codesourcery.com>
...@@ -23,7 +35,7 @@ ...@@ -23,7 +35,7 @@
PR fortran/92174 PR fortran/92174
* decl.c (attr_decl1): Move check for F2018:C822 from here ... * 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> 2019-10-18 Steven G. Kargl <kargl@gcc.gnu.org>
......
...@@ -16777,8 +16777,8 @@ resolve_equivalence (gfc_equiv *eq) ...@@ -16777,8 +16777,8 @@ resolve_equivalence (gfc_equiv *eq)
} }
/* Function called by resolve_fntype to flag other symbol used in the /* Function called by resolve_fntype to flag other symbols used in the
length type parameter specification of function resuls. */ length type parameter specification of function results. */
static bool static bool
flag_fn_result_spec (gfc_expr *expr, flag_fn_result_spec (gfc_expr *expr,
......
...@@ -369,44 +369,37 @@ gfc_sym_identifier (gfc_symbol * sym) ...@@ -369,44 +369,37 @@ gfc_sym_identifier (gfc_symbol * sym)
static const char * static const char *
mangled_identifier (gfc_symbol *sym) 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 /* Prevent the mangling of identifiers that have an assigned
binding label (mainly those that are bind(c)). */ binding label (mainly those that are bind(c)). */
if (sym->attr.is_bind_c == 1 && sym->binding_label) if (sym->attr.is_bind_c == 1 && sym->binding_label)
return 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) if (sym->module == NULL)
return sym_identifier (sym); return sym_identifier (sym);
else else
{ snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
return name;
}
} }
else else
{ {
/* This is an entity that is actually local to a module procedure /* This is an entity that is actually local to a module procedure
that appears in the result specification expression. Since that appears in the result specification expression. Since
sym->module will be a zero length string, we use ns->proc_name sym->module will be a zero length string, we use ns->proc_name
instead. */ to provide the module name instead. */
if (sym->ns->proc_name && sym->ns->proc_name->module) if (proc && proc->module)
{ snprintf (name, sizeof name, "__%s_MOD__%s_PROC_%s",
snprintf (name, sizeof name, "__%s_MOD__%s_PROC_%s", proc->module, proc->name, sym->name);
sym->ns->proc_name->module,
sym->ns->proc_name->name,
sym->name);
return name;
}
else else
{ snprintf (name, sizeof name, "__%s_PROC_%s",
snprintf (name, sizeof name, "__%s_PROC_%s", proc->name, sym->name);
sym->ns->proc_name->name, sym->name);
return name;
}
} }
return name;
} }
/* Get mangled identifier, adding the symbol to the global table if /* Get mangled identifier, adding the symbol to the global table if
......
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> 2019-10-26 Hongtao Liu <hongtao.liu@intel.com>
PR target/89071 PR target/89071
......
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment