https://gcc.gnu.org/g:cb25c5dd6b315dc216c7a5640dc89c5d74ffea34
commit r12-10720-gcb25c5dd6b315dc216c7a5640dc89c5d74ffea34 Author: Harald Anlauf <anl...@gmx.de> Date: Thu Sep 5 21:30:25 2024 +0200 Fortran: fix ICE in gfc_create_module_variable [PR100273] gcc/fortran/ChangeLog: PR fortran/100273 * trans-decl.cc (gfc_create_module_variable): Handle module variable also when it is needed for the result specification of a contained function. gcc/testsuite/ChangeLog: PR fortran/100273 * gfortran.dg/pr100273.f90: New test. (cherry picked from commit 1f462b5072a5e82c35921f7e3bdf3959c4a49dc9) Diff: --- gcc/fortran/trans-decl.cc | 3 ++- gcc/testsuite/gfortran.dg/pr100273.f90 | 26 ++++++++++++++++++++++++++ 2 files changed, 28 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 0e91553108f2..884978ad981d 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -5251,7 +5251,8 @@ gfc_create_module_variable (gfc_symbol * sym) /* Create the variable. */ pushdecl (decl); gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE - || (sym->ns->parent->proc_name->attr.flavor == FL_MODULE + || ((sym->ns->parent->proc_name->attr.flavor == FL_MODULE + || sym->ns->parent->proc_name->attr.flavor == FL_PROCEDURE) && sym->fn_result_spec)); DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl; rest_of_decl_compilation (decl, 1, 0); diff --git a/gcc/testsuite/gfortran.dg/pr100273.f90 b/gcc/testsuite/gfortran.dg/pr100273.f90 new file mode 100644 index 000000000000..f71947ad802d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr100273.f90 @@ -0,0 +1,26 @@ +! { dg-do compile } +! PR fortran/100273 - ICE in gfc_create_module_variable +! +! Contributed by G.Steinmetz + +module m + implicit none +contains + character(4) function g(k) + integer :: k + g = f(k) + contains + function f(n) + character(3), parameter :: a(2) = ['1 ', '123'] + integer :: n + character(len_trim(a(n))) :: f + f = 'abc' + end + end +end +program p + use m + implicit none + print *, '>>' // g(1) // '<<' + print *, '>>' // g(2) // '<<' +end