]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: Fix ICE in ASSOCIATE with user defined operator [PR121060]
authorPaul Thomas <pault@gcc.gnu.org>
Wed, 16 Jul 2025 05:16:57 +0000 (06:16 +0100)
committerPaul Thomas <pault@gcc.gnu.org>
Wed, 16 Jul 2025 05:16:57 +0000 (06:16 +0100)
2025-07-16  Paul Thomas  <pault@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.

gcc/fortran/interface.cc
gcc/testsuite/gfortran.dg/associate_75.f90 [new file with mode: 0644]

index f74fbf0f6e587479c3712124178f2d3bf6d9616f..d08f683498d1d915d8d87b6c78127726f3333822 100644 (file)
@@ -4781,6 +4781,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 (file)
index 0000000..c7c461a
--- /dev/null
@@ -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