https://gcc.gnu.org/g:80bb0bda4a96da7e690cb4df572fcb9604f511f8
commit r13-8716-g80bb0bda4a96da7e690cb4df572fcb9604f511f8 Author: Paul Thomas <pa...@gcc.gnu.org> Date: Thu Apr 25 06:56:10 2024 +0100 Fortran: Fix ICE in gfc_trans_create_temp_array from bad type [PR93678] 2024-04-25 Paul Thomas <pa...@gcc.gnu.org> gcc/fortran PR fortran/93678 * trans-expr.cc (gfc_conv_procedure_call): Use the interface, where possible, to obtain the type of character procedure pointers of class entities. gcc/testsuite/ PR fortran/93678 * gfortran.dg/pr93678.f90: New test. (cherry picked from commit c058105bc47a0701e157d1028e60f48554561f9f) Diff: --- gcc/fortran/trans-expr.cc | 10 ++++++++-- gcc/testsuite/gfortran.dg/pr93678.f90 | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 5c5fabf5f5ae..cfe03252582c 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -7626,8 +7626,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { gcc_assert (se->loop && info); - /* Set the type of the array. */ - tmp = gfc_typenode_for_spec (&comp->ts); + /* Set the type of the array. vtable charlens are not always reliable. + Use the interface, if possible. */ + if (comp->ts.type == BT_CHARACTER + && expr->symtree->n.sym->ts.type == BT_CLASS + && comp->ts.interface && comp->ts.interface->result) + tmp = gfc_typenode_for_spec (&comp->ts.interface->result->ts); + else + tmp = gfc_typenode_for_spec (&comp->ts); gcc_assert (se->ss->dimen == se->loop->dimen); /* Evaluate the bounds of the result, if known. */ diff --git a/gcc/testsuite/gfortran.dg/pr93678.f90 b/gcc/testsuite/gfortran.dg/pr93678.f90 new file mode 100644 index 000000000000..403bedd0c4fd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr93678.f90 @@ -0,0 +1,32 @@ +! { dg-do compile } +! Test the fix for PR93678 in which the charlen for the 'unpackbytes' +! vtable field was incomplete and caused the ICE as indicated. +! Contributed by Luis Kornblueh <mail.l...@web.de> +! +! The testcase was reduced by various gfortran regulars. +module mo_a + implicit none + type t_b + integer :: i + contains + procedure :: unpackbytes => b_unpackbytes + end type t_b +contains + function b_unpackbytes (me) result (res) + class(t_b), intent(inout) :: me + character :: res(1) + res = char (me%i) + end function b_unpackbytes + subroutine b_unpackint (me, c) + class(t_b), intent(inout) :: me + character, intent(in) :: c +! print *, b_unpackbytes (me) ! ok + if (any (me% unpackbytes () .ne. c)) stop 1 ! ICEd here + end subroutine b_unpackint +end module mo_a + + use mo_a + class(t_b), allocatable :: z + allocate (z, source = t_b(97)) + call b_unpackint (z, "a") +end