https://gcc.gnu.org/g:bbe98c93608b83844e999a8975862024fbe0579f
commit r16-6035-gbbe98c93608b83844e999a8975862024fbe0579f Author: Paul Thomas <[email protected]> Date: Thu Dec 11 16:51:53 2025 +0000 Fortran: Fix ICE arising from PDT class components [PR110012] 2025-12-11 Paul Thomas <[email protected]> gcc/fortran PR fortran/110012 * decl.cc (gfc_get_pdt_instance): Continue to loop through the type parameters components if param_list is null and the parameter is not KIND with a default initializer. * resolve.cc (resolve_fl_derived): If the data component is a PDT template, find the instance and build the class. gcc/testsuite PR fortran/110012 * gfortran.dg/pdt_77.f03: New test. Diff: --- gcc/fortran/decl.cc | 5 +++ gcc/fortran/resolve.cc | 18 ++++++++++- gcc/testsuite/gfortran.dg/pdt_77.f03 | 63 ++++++++++++++++++++++++++++++++++++ 3 files changed, 85 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 0e55171068b9..8f18f9e61a2c 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -4027,6 +4027,11 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, if (!pdt->attr.use_assoc && !c1) goto error_return; + /* Resolution PDT class components of derived types are handled here. + They can arrive without a parameter list and no KIND parameters. */ + if (!param_list && (!c1->attr.pdt_kind && !c1->initializer)) + continue; + kind_expr = NULL; if (!name_seen) { diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index db6b52f30760..153ff42f290e 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -17628,6 +17628,22 @@ resolve_fl_derived (gfc_symbol *sym) gfc_component *data = gfc_find_component (sym, "_data", true, true, NULL); gfc_component *vptr = gfc_find_component (sym, "_vptr", true, true, NULL); + if (data->ts.u.derived->attr.pdt_template) + { + match m; + m = gfc_get_pdt_instance (sym->param_list, &data->ts.u.derived, + &data->param_list); + if (m != MATCH_YES + || !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as)) + { + gfc_error ("Failed to build PDT class component at %L", + &sym->declared_at); + return false; + } + data = gfc_find_component (sym, "_data", true, true, NULL); + vptr = gfc_find_component (sym, "_vptr", true, true, NULL); + } + /* Nothing more to do for unlimited polymorphic entities. */ if (data->ts.u.derived->attr.unlimited_polymorphic) { @@ -17639,7 +17655,7 @@ resolve_fl_derived (gfc_symbol *sym) gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived); gcc_assert (vtab); vptr->ts.u.derived = vtab->ts.u.derived; - if (!resolve_fl_derived0 (vptr->ts.u.derived)) + if (vptr->ts.u.derived && !resolve_fl_derived0 (vptr->ts.u.derived)) return false; } } diff --git a/gcc/testsuite/gfortran.dg/pdt_77.f03 b/gcc/testsuite/gfortran.dg/pdt_77.f03 new file mode 100644 index 000000000000..627c0f0de807 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_77.f03 @@ -0,0 +1,63 @@ +! { dg-do run } +! +! Test the fix for PR110012, which failed to compile with an ICE. +! +! Contributed by Neil Carlson <[email protected]> +! +module pde_class + type, abstract :: pde(npde) + integer,len :: npde + end type +end module + +module navier_stokes_type + use pde_class + type, extends(pde) :: navier_stokes + integer, allocatable :: data_(:) + end type +contains + subroutine alloc_navier_stokes(p , n) + class(pde(:)), allocatable :: p + integer :: n + allocate(navier_stokes(npde=n) :: p) + select type (p) + type is (navier_stokes(*)) + p%data_ = [(i, i = 1, p%npde)] + end select + end subroutine +end module + +module mfe_disc_type + use pde_class + type :: foo + class(pde(:)), allocatable :: p ! This caused the ICE in resolution. + end type +end module + +program test + call navier_stokes_test + call mfe_disc_test +contains + subroutine navier_stokes_test + use navier_stokes_type + class (pde(:)), allocatable :: x + call alloc_navier_stokes (x, 4) + select type (x) + type is (navier_stokes(*)) + if (any (x%data_ /= [1,2,3,4])) stop 1 + end select + end subroutine + + subroutine mfe_disc_test + use navier_stokes_type + use mfe_disc_type + type (foo), allocatable :: x + allocate (x) + call alloc_navier_stokes (x%p, 3) + select type (z => x%p) + type is (navier_stokes(*)) + if (any (z%data_ /= [1,2,3])) stop 2 + end select + if (allocated (x) .and. allocated (x%p)) deallocate (x%p) + end subroutine +end program
