diff options
author | Paul Thomas <pault@gcc.gnu.org> | 2024-04-25 06:56:10 +0100 |
---|---|---|
committer | Paul Thomas <pault@gcc.gnu.org> | 2024-04-25 06:56:10 +0100 |
commit | c058105bc47a0701e157d1028e60f48554561f9f (patch) | |
tree | ab45ab8a3f960f6337929d2ac8262514b9c02f8a | |
parent | 1fd5a07444776d76cdd6a2eee7df0478201197a5 (diff) | |
download | gcc-c058105bc47a0701e157d1028e60f48554561f9f.zip gcc-c058105bc47a0701e157d1028e60f48554561f9f.tar.gz gcc-c058105bc47a0701e157d1028e60f48554561f9f.tar.bz2 |
Fortran: Fix ICE in gfc_trans_create_temp_array from bad type [PR93678]
2024-04-25 Paul Thomas <pault@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.
-rw-r--r-- | gcc/fortran/trans-expr.cc | 10 | ||||
-rw-r--r-- | 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 605434f..072adf3 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -7879,8 +7879,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 0000000..403bedd --- /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.luis@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 |