https://gcc.gnu.org/g:4ba8f2102fec5e04df28e912036283b67aff6c07
commit r14-11892-g4ba8f2102fec5e04df28e912036283b67aff6c07
Author: Paul Thomas <pa...@gcc.gnu.org>
Date: Wed Jul 16 06:16:57 2025 +0100
Fortran: Fix ICE in ASSOCIATE with user defined operator [PR121060]
2025-07-16 Paul Thomas <pa...@gcc.gnu.org>
gcc/fortran
PR fortran/121060
* interface.cc (matching_typebound_op): Defer determination of
specific procedure until resolution by returning NULL.
gcc/testsuite/
PR fortran/121060
* gfortran.dg/associate_75.f90: New test.
(cherry picked from commit 82e912344d28cf1a69e5f8e047203ea7eb625302)
Diff:
---
gcc/fortran/interface.cc | 7 +++++
gcc/testsuite/gfortran.dg/associate_75.f90 | 50 ++++++++++++++++++++++++++++++
2 files changed, 57 insertions(+)
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 25f27f83458c..a3f0a5306f5c 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -4622,6 +4622,13 @@ matching_typebound_op (gfc_expr** tb_base,
gfc_actual_arglist* argcopy;
bool matches;
+ /* If expression matching comes here during parsing, eg. when
+ parsing ASSOCIATE, generic TBPs have not yet been resolved
+ and g->specific will not have been set. Wait for expression
+ resolution by returning NULL. */
+ if (!g->specific && !gfc_current_ns->resolved)
+ return NULL;
+
gcc_assert (g->specific);
if (g->specific->error)
continue;
diff --git a/gcc/testsuite/gfortran.dg/associate_75.f90
b/gcc/testsuite/gfortran.dg/associate_75.f90
new file mode 100644
index 000000000000..c7c461a5cb65
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_75.f90
@@ -0,0 +1,50 @@
+! { dg-do run }
+!
+! Test fix for PR121060.
+!
+! Contributed by Damian Rouson <damian@archaeologic.codes>
+!
+module subdomain_m
+ implicit none
+
+ type subdomain_t
+ real :: s_ = 99.
+ contains
+ generic :: operator(.laplacian.) => laplacian
+ procedure laplacian
+ end type
+
+contains
+
+ function laplacian(rhs)
+ class(subdomain_t), intent(in) :: rhs
+ type(subdomain_t) laplacian
+ laplacian%s_ = rhs%s_ + 42
+ end function
+
+end module
+
+ use subdomain_m
+ implicit none
+
+ type operands_t
+ real :: s_
+ end type
+
+ type(subdomain_t) phi
+ type(operands_t) operands
+
+ associate(laplacian_phi => .laplacian. phi) ! ICE because specific not found.
+ operands = approximates(laplacian_phi%s_)
+ end associate
+
+ if (int (operands%s_) /= 42) stop 1
+contains
+
+ function approximates(actual)
+ real actual
+ type(operands_t) approximates
+ approximates%s_ = actual - 99
+ end function
+
+end
