https://gcc.gnu.org/g:c50c7871ccc938fb700af33879e1e8b29e1c11b6
commit r16-6036-gc50c7871ccc938fb700af33879e1e8b29e1c11b6 Author: Paul Thomas <[email protected]> Date: Thu Dec 11 17:24:07 2025 +0000 Fortran: Fix ICE arising from PDT class components [PR107142] 2025-12-11 Paul Thomas <[email protected]> gcc/fortran PR fortran/107142 * match.cc (gfc_match_type_spec): Change original declaration to static match_type_spec and call from gfc_match_type_spec, where the gfc_current_ns is stashed and restored after call. (gfc_match_type_is): Before emitting the syntax error message check if there are any pending error messages and use them instead. gcc/testsuite PR fortran/107142 * gfortran.dg/pdt_78.f03: New test. Diff: --- gcc/fortran/match.cc | 19 ++++++++++++++++--- gcc/testsuite/gfortran.dg/pdt_78.f03 | 23 +++++++++++++++++++++++ 2 files changed, 39 insertions(+), 3 deletions(-) diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index e009c82b0bd0..666eef4c9375 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -2305,8 +2305,8 @@ match_derived_type_spec (gfc_typespec *ts) the implicit_flag is not needed, so it was removed. Derived types are identified by their name alone. */ -match -gfc_match_type_spec (gfc_typespec *ts) +static match +match_type_spec (gfc_typespec *ts) { match m; locus old_locus; @@ -2516,6 +2516,17 @@ kind_selector: } +match +gfc_match_type_spec (gfc_typespec *ts) +{ + match m; + gfc_namespace *old_ns = gfc_current_ns; + m = match_type_spec (ts); + gfc_current_ns = old_ns; + return m; +} + + /******************** FORALL subroutines ********************/ /* Free a list of FORALL iterators. */ @@ -7941,7 +7952,9 @@ gfc_match_type_is (void) return MATCH_YES; syntax: - gfc_error ("Syntax error in TYPE IS specification at %C"); + + if (!gfc_error_check ()) + gfc_error ("Syntax error in TYPE IS specification at %C"); cleanup: if (c != NULL) diff --git a/gcc/testsuite/gfortran.dg/pdt_78.f03 b/gcc/testsuite/gfortran.dg/pdt_78.f03 new file mode 100644 index 000000000000..27e405d72ee6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_78.f03 @@ -0,0 +1,23 @@ +! { dg-do compile } +! +! Test the fix for PR107142, which used to ICE after a syntax error. +! +! Contributed by Arseny Solokha <[email protected]> +! +module c1162a + type pdt(kind,len) + integer, kind :: kind + integer, len :: len + end type + contains + subroutine foo(x) + class(pdt(kind = 1, len = :)), allocatable :: x + select type (x) + type is (pdt(kind = *, len = *)) ! { dg-error "does not have a default value" } + type is (pdt(kind = :, len = *)) ! { dg-error "does not have a default value" } + end select + select type (x) + type is (pdt(kind = 1, len = *)) ! This, of course, is OK + end select + end subroutine +end module
