https://gcc.gnu.org/g:05d3dd6010a53e93e1693001eba4c88a7face53b
commit r16-4269-g05d3dd6010a53e93e1693001eba4c88a7face53b Author: Paul Thomas <[email protected]> Date: Tue Oct 7 13:30:43 2025 +0100 Fortran: Fix ICE in pdt_1[3-5].f03 with -fcheck=all [PR102901] 2025-10-07 Paul Thomas <[email protected]> gcc/fortran PR fortran/102901 * trans-array.cc (structure_alloc_comps): Do not use gfc_check_pdt_dummy with pointer or allocatable components. gcc/testsuite/ PR fortran/102901 * gfortran.dg/pdt_56.f03: Copy of pdt_13.f03 compiled with -fcheck=all. Diff: --- gcc/fortran/trans-array.cc | 6 ++- gcc/testsuite/gfortran.dg/pdt_56.f03 | 96 ++++++++++++++++++++++++++++++++++++ 2 files changed, 101 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index db34de44401b..9dd61f98ca76 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -11180,7 +11180,11 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, comp = gfc_class_data_get (comp); /* Recurse in to PDT components. */ - if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) + if (((c->ts.type == BT_DERIVED + && !c->attr.allocatable && !c->attr.pointer) + || (c->ts.type == BT_CLASS + && !CLASS_DATA (c)->attr.allocatable + && !CLASS_DATA (c)->attr.pointer)) && c->ts.u.derived && c->ts.u.derived->attr.pdt_type) { tmp = gfc_check_pdt_dummy (c->ts.u.derived, comp, diff --git a/gcc/testsuite/gfortran.dg/pdt_56.f03 b/gcc/testsuite/gfortran.dg/pdt_56.f03 new file mode 100644 index 000000000000..681d47937029 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_56.f03 @@ -0,0 +1,96 @@ +! { dg-do compile } +! { dg-options "-fcheck=all" } +! +! Test the fix for PR102901, where pdt_13/14/15.f03 segfaulted in compilation +! with -fcheck=all. +! +! Reported by Tobias Burnus <[email protected]> +! +! This is pdt_13.f03. +! +module precision_module + implicit none + integer, parameter :: sp = selected_real_kind(6, 37) + integer, parameter :: dp = selected_real_kind(15, 307) + integer, parameter :: qp = selected_real_kind( 30, 291) +end module precision_module + +module link_module + use precision_module + + type link(real_kind) + integer, kind :: real_kind + real (kind=real_kind) :: n + type (link(real_kind)), pointer :: next => NULL() + end type link + +contains + + function push_8 (self, arg) result(current) + real(dp) :: arg + type (link(real_kind=dp)), pointer :: self + type (link(real_kind=dp)), pointer :: current + + if (associated (self)) then + current => self + do while (associated (current%next)) + current => current%next + end do + + allocate (current%next) + current => current%next + else + allocate (current) + self => current + end if + + current%n = arg + current%next => NULL () + end function push_8 + + function pop_8 (self) result(res) + type (link(real_kind=dp)), pointer :: self + type (link(real_kind=dp)), pointer :: current => NULL() + type (link(real_kind=dp)), pointer :: previous => NULL() + real(dp) :: res + + res = 0.0_8 + if (associated (self)) then + current => self + do while (associated (current) .and. associated (current%next)) + previous => current + current => current%next + end do + + previous%next => NULL () + + res = current%n + if (associated (self, current)) then + deallocate (self) + else + deallocate (current) + end if + + end if + end function pop_8 + +end module link_module + +program ch2701 + use precision_module + use link_module + implicit none + integer, parameter :: wp = dp + type (link(real_kind=wp)), pointer :: root => NULL() + type (link(real_kind=wp)), pointer :: current + + current => push_8 (root, 1.0_8) + current => push_8 (root, 2.0_8) + current => push_8 (root, 3.0_8) + + if (int (pop_8 (root)) .ne. 3) STOP 1 + if (int (pop_8 (root)) .ne. 2) STOP 2 + if (int (pop_8 (root)) .ne. 1) STOP 3 + if (int (pop_8 (root)) .ne. 0) STOP 4 + +end program ch2701
