https://gcc.gnu.org/g:882d2e6c3584f6844359a50239813fb447dcb20e
commit r16-6470-g882d2e6c3584f6844359a50239813fb447dcb20e Author: Paul Thomas <[email protected]> Date: Sat Jan 3 07:37:28 2026 +0000 Fortran: Invalid association with operator-result selector [PR123352] 2026-01-03 Paul Thomas <[email protected]> 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 <[email protected]> +! +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" } }
