[gcc r16-6470] Fortran: Invalid association with operator-result selector [PR123352]
Paul Thomas
pault@gcc.gnu.org
Sat Jan 3 07:37:39 GMT 2026
https://gcc.gnu.org/g:882d2e6c3584f6844359a50239813fb447dcb20e
commit r16-6470-g882d2e6c3584f6844359a50239813fb447dcb20e
Author: Paul Thomas <pault@gcc.gnu.org>
Date: Sat Jan 3 07:37:28 2026 +0000
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:
---
gcc/fortran/gfortran.h | 1 +
gcc/fortran/interface.cc | 4 +++
gcc/fortran/match.cc | 11 ++++++++
gcc/fortran/resolve.cc | 7 +++++
gcc/testsuite/gfortran.dg/associate_78.f90 | 44 ++++++++++++++++++++++++++++++
5 files changed, 67 insertions(+)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cd81ac0398c5..cafd3ab53fef 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 a25e7b91a5ae..d29cb3a3b82b 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 1655e84f8163..64bfeb091890 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 922f16d9eb68..33a183e74146 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 000000000000..7fded52fa849
--- /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" } }
More information about the Gcc-cvs
mailing list