From: Paul Thomas <pault@gcc.gnu.org>
Date: Sat, 3 Jan 2026 07:37:28 +0000 (+0000)
Subject: Fortran:  Invalid association with operator-result selector [PR123352]
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=882d2e6c3584f6844359a50239813fb447dcb20e;p=thirdparty%2Fgcc.git

Fortran:  Invalid association with operator-result selector [PR123352]

2026-01-03  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/123352
	* gfortran.h: Add prototype for gfc_resolve_symbol.
	* interface.cc (matching_typebound_op): If the current
	namespace has not been resolved and the derived type is use
	associated, resolve the derived type with gfc_resolve_symbol.
	* match.cc (match_association_list): If the associate name is
	unknown type and the selector is an operator expression, copy
	the selector and call gfc_extend_expr. Replace the selector if
	there is a match, otherwise free the copy.
	* resolve.cc (gfc_resolve_symbol): New function.

gcc/testsuite/
	PR fortran/123352
	* gfortran.dg/associate_78.f90: New test.
---

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cd81ac0398c..cafd3ab53fe 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -4052,6 +4052,7 @@ void gfc_free_statements (gfc_code *);
 void gfc_free_association_list (gfc_association_list *);
 
 /* resolve.cc */
+void gfc_resolve_symbol (gfc_symbol *);
 void gfc_expression_rank (gfc_expr *);
 bool gfc_op_rank_conformable (gfc_expr *, gfc_expr *);
 bool gfc_resolve_ref (gfc_expr *);
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index a25e7b91a5a..d29cb3a3b82 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -4849,6 +4849,10 @@ matching_typebound_op (gfc_expr** tb_base,
 	else
 	  derived = base->expr->ts.u.derived;
 
+	/* A use associated derived type is resolvable during parsing.  */
+	if (derived && derived->attr.use_assoc && !gfc_current_ns->resolved)
+	  gfc_resolve_symbol (derived);
+
 	if (op == INTRINSIC_USER)
 	  {
 	    gfc_symtree* tb_uop;
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 1655e84f816..64bfeb09189 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -2141,6 +2141,17 @@ match_association_list (bool for_change_team = false)
 	      goto assocListError;
 	    }
 	}
+      else if (newAssoc->target->ts.type == BT_UNKNOWN
+	       && newAssoc->target->expr_type == EXPR_OP)
+	{
+	  /* This will work for sure if the operator is type bound to a use
+	     associated derived type.  */
+	  gfc_expr *tmp =gfc_copy_expr (newAssoc->target);
+	  if (gfc_extend_expr (tmp) == MATCH_YES)
+	    gfc_replace_expr (newAssoc->target, tmp);
+	  else
+	    gfc_free_expr (tmp);
+	}
 
       /* The `variable' field is left blank for now; because the target is not
 	 yet resolved, we can't use gfc_has_vector_subscript to determine it
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 922f16d9eb6..33a183e7414 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -18819,6 +18819,13 @@ skip_interfaces:
 }
 
 
+void gfc_resolve_symbol (gfc_symbol *sym)
+{
+  resolve_symbol (sym);
+  return;
+}
+
+
 /************* Resolve DATA statements *************/
 
 static struct
diff --git a/gcc/testsuite/gfortran.dg/associate_78.f90 b/gcc/testsuite/gfortran.dg/associate_78.f90
new file mode 100644
index 00000000000..7fded52fa84
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_78.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR123352, which failed as shown. The operator in the first
+! selector was not being resolved and so 'op_foo' did not have a type.
+!
+! Contributed by Damian Rouson  <damian@archaeologic.codes>
+!
+module tensors_m
+  implicit none
+
+  type foo_t
+  contains
+    generic :: operator(.op.) => op
+    procedure op
+    procedure f
+  end type
+
+contains
+
+  type(foo_t) function op(self)
+    class(foo_t), intent(in) :: self
+    op = self
+  end function
+
+  integer function f(self)
+    class(foo_t) self
+    f = 42
+  end function
+
+end module
+
+  use tensors_m
+  implicit none
+  type(foo_t) foo
+
+  associate(op_foo => .op. foo)
+    associate(op_foo_f => op_foo%f()) ! Error: Invalid association target at (1)
+      print *, op_foo_f
+    end associate
+  end associate                       ! Error: Expecting END PROGRAM statement at (1)
+end
+! { dg-final { scan-tree-dump-times "struct foo_t op_foo;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "integer.kind=4. op_foo_f;" 1 "original" } }