This one was what we call a 3-fer. Next in line on the PR125515 list.
See attached patch.
Regression tested on x86-64.
OK for mainline and then backport to 16?
Regards,
Jerry
---
fortran: ICE or wrong-code for ASSOCIATE selector that is a
type-bound user-defined operator
Three related bugs prevented ASSOCIATE selectors that are type-bound
user-defined operator expressions from compiling correctly.
Bug 1 (class.cc): find_typebound_proc_uop returned NULL immediately when
the derived type has no f2k_derived namespace, bypassing the parent-type
inheritance walk. This caused inherited UDOs to be silently not found.
Fix: set root = NULL and let the loop reach the parent type instead.
Bug 2 (resolve.cc): resolve_typebound_procedures called resolve_symbol on
the parent type only after an early return that fires when the derived type
has no direct type-bound bindings. This left parent-type bindings
unresolved when searched via gfc_find_typebound_user_op.
Fix: move resolve_symbol(super_type) before the early return.
Bug 3 (match.cc): match_association_list did not handle ASSOCIATE selectors
of the form .uop. expr or the nested case .uop2. (.uop1. expr). When the
selector's type was BT_UNKNOWN at parse time the name of the associate
variable was left untyped, producing a "Syntax error in expression" ICE in
the body of the ASSOCIATE construct.
Fix: add three helpers before match_association_list:
- resolve_assoc_operand: attempts gfc_resolve_expr on EXPR_FUNCTION
operands and falls back to gfc_find_dt_in_generic for constructor calls
whose argument types are not yet known.
- infer_typebound_uop_type: reads the return type of a type-bound UDO
directly from specific_st->n.tb->u.specific->n.sym without calling
gfc_resolve_symbol, avoiding a resolve_symbol_called race condition.
- extend_assoc_op: walks the expression tree bottom-up, propagating
types through INTRINSIC_PARENTHESES wrappers before calling the two
helpers above on each INTRINSIC_USER node.
When the selector is an INTRINSIC_USER EXPR_OP with BT_UNKNOWN type,
call extend_assoc_op on the operands, then gfc_extend_expr (errors
suppressed). Accept the result when gfc_extend_expr returns MATCH_YES or
when it returns MATCH_ERROR but has already converted the node to
EXPR_COMPCALL with a known type (the full resolution pass finishes it).
PR fortran/125528
Assisted by: Claude Sonnet 4.6
gcc/fortran/ChangeLog:
PR fortran/125528
* class.cc (find_typebound_proc_uop): Set root = NULL instead of
returning NULL when derived type lacks f2k_derived, so parent-type
type-bound procedures and operators are still found via inheritance.
* match.cc (resolve_assoc_operand): New helper.
(infer_typebound_uop_type): New helper.
(extend_assoc_op): New helper.
(match_association_list): Handle ASSOCIATE selectors that are
type-bound user-defined operator expressions, including nested cases.
* resolve.cc (resolve_typebound_procedures): Move resolve_symbol
call for the parent type before the early return so inherited
type-bound bindings are resolved even when the child type has none
of its own.
gcc/testsuite/ChangeLog:
PR fortran/125528
* gfortran.dg/associate_80.f90: New test.
---From 9bab576f32c66218f9b8e7f3c95d9e12988579ea Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Wed, 27 May 2026 15:10:07 -0700
Subject: [PATCH] fortran: ICE or wrong-code for ASSOCIATE selector that is a
type-bound user-defined operator
Three related bugs prevented ASSOCIATE selectors that are type-bound
user-defined operator expressions from compiling correctly.
Bug 1 (class.cc): find_typebound_proc_uop returned NULL immediately when
the derived type has no f2k_derived namespace, bypassing the parent-type
inheritance walk. This caused inherited UDOs to be silently not found.
Fix: set root = NULL and let the loop reach the parent type instead.
Bug 2 (resolve.cc): resolve_typebound_procedures called resolve_symbol on
the parent type only after an early return that fires when the derived type
has no direct type-bound bindings. This left parent-type bindings
unresolved when searched via gfc_find_typebound_user_op.
Fix: move resolve_symbol(super_type) before the early return.
Bug 3 (match.cc): match_association_list did not handle ASSOCIATE selectors
of the form .uop. expr or the nested case .uop2. (.uop1. expr). When the
selector's type was BT_UNKNOWN at parse time the name of the associate
variable was left untyped, producing a "Syntax error in expression" ICE in
the body of the ASSOCIATE construct.
Fix: add three helpers before match_association_list:
- resolve_assoc_operand: attempts gfc_resolve_expr on EXPR_FUNCTION
operands and falls back to gfc_find_dt_in_generic for constructor calls
whose argument types are not yet known.
- infer_typebound_uop_type: reads the return type of a type-bound UDO
directly from specific_st->n.tb->u.specific->n.sym without calling
gfc_resolve_symbol, avoiding a resolve_symbol_called race condition.
- extend_assoc_op: walks the expression tree bottom-up, propagating
types through INTRINSIC_PARENTHESES wrappers before calling the two
helpers above on each INTRINSIC_USER node.
When the selector is an INTRINSIC_USER EXPR_OP with BT_UNKNOWN type,
call extend_assoc_op on the operands, then gfc_extend_expr (errors
suppressed). Accept the result when gfc_extend_expr returns MATCH_YES or
when it returns MATCH_ERROR but has already converted the node to
EXPR_COMPCALL with a known type (the full resolution pass finishes it).
PR fortran/125528
Assisted by: Claude Sonnet 4.6
gcc/fortran/ChangeLog:
PR fortran/125528
* class.cc (find_typebound_proc_uop): Set root = NULL instead of
returning NULL when derived type lacks f2k_derived, so parent-type
type-bound procedures and operators are still found via inheritance.
* match.cc (resolve_assoc_operand): New helper.
(infer_typebound_uop_type): New helper.
(extend_assoc_op): New helper.
(match_association_list): Handle ASSOCIATE selectors that are
type-bound user-defined operator expressions, including nested cases.
* resolve.cc (resolve_typebound_procedures): Move resolve_symbol
call for the parent type before the early return so inherited
type-bound bindings are resolved even when the child type has none
of its own.
gcc/testsuite/ChangeLog:
PR fortran/125528
* gfortran.dg/associate_80.f90: New test.
---
gcc/fortran/class.cc | 4 +-
gcc/fortran/match.cc | 186 ++++++++++++++++++++-
gcc/fortran/resolve.cc | 10 +-
gcc/testsuite/gfortran.dg/associate_80.f90 | 83 +++++++++
4 files changed, 273 insertions(+), 10 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/associate_80.f90
diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index a4c3c37104a..d811ee2929c 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -3136,7 +3136,9 @@ find_typebound_proc_uop (gfc_symbol* derived, bool* t,
root = (uop ? derived->f2k_derived->tb_uop_root
: derived->f2k_derived->tb_sym_root);
else
- return NULL;
+ /* No f2k_derived namespace; allow the extension check below to proceed
+ so inherited type-bound procedures/operators are still found. */
+ root = NULL;
/* Try to find it in the current type's namespace. */
res = gfc_find_symtree (root, name);
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index d892a4588b2..9172f46ed7c 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -1980,6 +1980,155 @@ check_coarray_assoc (const char *name, gfc_association_list *assoc)
return true;
}
+/* Try to resolve an EXPR_FUNCTION operand so its return type is known.
+ Called during ASSOCIATE selector parsing, before type-bound operator
+ extension, when the operand is an unresolved generic constructor call
+ such as `scalar_1D_t(initializer, order=2, ...)`. Errors are suppressed
+ since we are still in the parsing phase. */
+
+static void
+resolve_assoc_operand (gfc_expr *e)
+{
+ if (!e || e->ts.type != BT_UNKNOWN || e->expr_type != EXPR_FUNCTION)
+ return;
+
+ /* First, try full expression resolution (works when argument types are
+ already known at parse time). */
+ gfc_push_suppress_errors ();
+ gfc_resolve_expr (e);
+ gfc_pop_suppress_errors ();
+
+ if (e->ts.type != BT_UNKNOWN)
+ return;
+
+ /* Fallback for generic constructor interfaces such as
+ scalar_1D_t(initializer, order=2, cells=16, x_min=0D0, x_max=5D0)
+ where full argument resolution is not possible at parse time.
+ If the function name resolves to a generic interface that wraps a
+ derived type (a constructor interface), infer the return type as
+ that derived type. */
+ if (!e->symtree || !e->symtree->n.sym)
+ return;
+
+ gfc_symbol *dt_sym = gfc_find_dt_in_generic (e->symtree->n.sym);
+ if (dt_sym && gfc_fl_struct (dt_sym->attr.flavor))
+ {
+ e->ts.type = BT_DERIVED;
+ e->ts.u.derived = dt_sym;
+ }
+}
+
+/* Infer the return type of a type-bound user-defined operator without
+ converting the expression node or triggering gfc_resolve_symbol on the
+ return type. This is used during ASSOCIATE selector parsing to propagate
+ type information bottom-up through nested UDO expressions such as
+ (.div. (.grad. x)), so that the outer gfc_extend_expr can locate the
+ type-bound .div. once the type of (.grad. x) is known.
+
+ Calling gfc_extend_expr for this purpose would partially resolve the
+ return type's derived-type symbol (setting resolve_symbol_called before
+ resolve_typebound_procedures has run), which prevents the subsequent
+ outer gfc_extend_expr from properly resolving the type-bound operator
+ on the return type. We avoid that by reading the return type directly
+ from the procedure's result variable without triggering resolution. */
+
+static void
+infer_typebound_uop_type (gfc_expr *e)
+{
+ if (!e || e->expr_type != EXPR_OP || e->value.op.op != INTRINSIC_USER
+ || e->ts.type != BT_UNKNOWN)
+ return;
+
+ /* Find the operand and strip parentheses. */
+ gfc_expr *operand = e->value.op.op1;
+ while (operand && operand->expr_type == EXPR_OP
+ && operand->value.op.op == INTRINSIC_PARENTHESES)
+ operand = operand->value.op.op1;
+
+ if (!operand || operand->ts.type != BT_DERIVED || !operand->ts.u.derived)
+ return;
+
+ /* Look up the UDO binding in the derived type's namespace (and its
+ parent types, via the recursion in find_typebound_proc_uop). This
+ does not call resolve_symbol, so it leaves resolve_symbol_called
+ untouched for all types involved. */
+ bool ok = true;
+ gfc_symtree *tb_uop
+ = gfc_find_typebound_user_op (operand->ts.u.derived, &ok,
+ e->value.op.uop->name, false, NULL);
+ if (!tb_uop || !tb_uop->n.tb)
+ return;
+
+ gfc_typebound_proc *tb = tb_uop->n.tb;
+ if (!tb->is_generic || !tb->u.generic)
+ return;
+
+ /* Take the first specific binding. specific_st is set from module reading;
+ its n.tb is the gfc_typebound_proc for that specific binding (same as
+ what resolve_typebound_procedures later stores in g->specific). Follow
+ the chain specific_st->n.tb->u.specific->n.sym to reach the actual
+ implementing function symbol, whose ts holds the return type.
+ This mirrors what build_compcall_for_operator does via
+ g->specific->u.specific->n.sym->ts after resolution. */
+ gfc_tbp_generic *g = tb->u.generic;
+ if (!g->specific_st || !g->specific_st->n.tb)
+ return;
+
+ gfc_typebound_proc *specific_tb = g->specific_st->n.tb;
+ if (specific_tb->is_generic || !specific_tb->u.specific
+ || !specific_tb->u.specific->n.sym)
+ return;
+
+ gfc_symbol *proc = specific_tb->u.specific->n.sym;
+ if (proc->ts.type != BT_UNKNOWN)
+ e->ts = proc->ts;
+}
+
+/* Recursively propagate type information bottom-up through a nested UDO
+ expression tree so that when gfc_extend_expr is called on the outermost
+ operator during ASSOCIATE selector parsing, the inner operands already have
+ their types set and the type-bound lookup can succeed. Uses
+ infer_typebound_uop_type rather than gfc_extend_expr to avoid triggering
+ resolve_symbol on the return types, which would prevent the outer
+ gfc_extend_expr from working correctly. */
+
+static void
+extend_assoc_op (gfc_expr *e)
+{
+ if (!e || e->expr_type != EXPR_OP)
+ return;
+
+ /* Bottom-up: process children first. */
+ extend_assoc_op (e->value.op.op1);
+ extend_assoc_op (e->value.op.op2);
+
+ /* Propagate the child's type upward through parentheses nodes.
+ gfc_extend_expr's matching_typebound_op checks ts.type BEFORE stripping
+ INTRINSIC_PARENTHESES wrappers, so an untyped parentheses node prevents
+ the outer operator from being found. */
+ if (e->value.op.op == INTRINSIC_PARENTHESES
+ && e->ts.type == BT_UNKNOWN
+ && e->value.op.op1
+ && e->value.op.op1->ts.type != BT_UNKNOWN)
+ {
+ e->ts = e->value.op.op1->ts;
+ return;
+ }
+
+ /* Only handle unresolved user-defined operators. */
+ if (e->value.op.op != INTRINSIC_USER || e->ts.type != BT_UNKNOWN)
+ return;
+
+ /* Try to infer the type of each operand if it is an unresolved constructor
+ call (EXPR_FUNCTION whose return type is still BT_UNKNOWN). */
+ resolve_assoc_operand (e->value.op.op1);
+ resolve_assoc_operand (e->value.op.op2);
+
+ /* Infer this operator's return type from the type-bound procedure's result
+ variable, without calling gfc_resolve_symbol on the return type. */
+ infer_typebound_uop_type (e);
+}
+
match
match_association_list (bool for_change_team = false)
{
@@ -2142,12 +2291,37 @@ match_association_list (bool for_change_team = false)
}
}
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)
+ && newAssoc->target->expr_type == EXPR_OP
+ && newAssoc->target->value.op.op == INTRINSIC_USER)
+ {
+ /* If the selector is an unresolved type-bound user-defined operator
+ expression, try to extend it now so the associate name gets a usable
+ type. For nested operators such as
+ (.div. (.grad. x))
+ first propagate types bottom-up through the inner operands
+ (extend_assoc_op). For a direct operator applied to a constructor
+ call such as
+ (.div. vector_t(init_fn, n=8))
+ additionally resolve the direct operands as constructor calls
+ (resolve_assoc_operand). Then call gfc_extend_expr on the
+ outermost operator. Only handle INTRINSIC_USER here; arithmetic
+ operators are left to the normal resolution pass. */
+ gfc_expr *tmp = gfc_copy_expr (newAssoc->target);
+ extend_assoc_op (tmp->value.op.op1);
+ extend_assoc_op (tmp->value.op.op2);
+ resolve_assoc_operand (tmp->value.op.op1);
+ resolve_assoc_operand (tmp->value.op.op2);
+ /* Suppress errors from gfc_extend_expr: during parsing the full
+ resolution has not run yet, so gfc_resolve_expr(COMPCALL) may
+ fail even when the type-bound operator was found and the node
+ was correctly converted to EXPR_COMPCALL. Accept the conversion
+ in that case and let the normal resolution pass finish it. */
+ gfc_push_suppress_errors ();
+ match ext_m = gfc_extend_expr (tmp);
+ gfc_pop_suppress_errors ();
+ if (ext_m == MATCH_YES
+ || (tmp->expr_type == EXPR_COMPCALL
+ && tmp->ts.type != BT_UNKNOWN))
gfc_replace_expr (newAssoc->target, tmp);
else
gfc_free_expr (tmp);
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index a31f395709d..df91671e171 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -17218,13 +17218,17 @@ resolve_typebound_procedures (gfc_symbol* derived)
int op;
gfc_symbol* super_type;
- if (!derived->f2k_derived || !derived->f2k_derived->tb_sym_root)
- return true;
-
+ /* Resolve the super-type first so that inherited bindings (including
+ user operators) are fully resolved before we look them up via
+ gfc_find_typebound_user_op. This must happen even when 'derived'
+ has no direct type-bound bindings of its own. */
super_type = gfc_get_derived_super_type (derived);
if (super_type)
resolve_symbol (super_type);
+ if (!derived->f2k_derived || !derived->f2k_derived->tb_sym_root)
+ return true;
+
resolve_bindings_derived = derived;
resolve_bindings_result = true;
diff --git a/gcc/testsuite/gfortran.dg/associate_80.f90 b/gcc/testsuite/gfortran.dg/associate_80.f90
new file mode 100644
index 00000000000..14c405c8f22
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_80.f90
@@ -0,0 +1,83 @@
+! { dg-do run }
+!
+! Test ASSOCIATE selectors that are type-bound user-defined operators (UDOs),
+! including inherited operators and nested expressions such as
+! .div. (.grad. x). PR fortran/125515
+!
+module associate_80_m
+ implicit none
+
+ type :: scalar_t
+ real :: val
+ contains
+ generic :: operator(.grad.) => do_grad
+ procedure, private :: do_grad
+ generic :: operator(.sq.) => do_sq
+ procedure, private :: do_sq
+ generic :: get => get_val
+ procedure :: get_val
+ end type
+
+ type, extends(scalar_t) :: vector_t
+ contains
+ generic :: operator(.div.) => do_div
+ procedure, private :: do_div
+ end type
+
+contains
+
+ ! .grad. on scalar_t -> vector_t
+ pure function do_grad (self) result (r)
+ class(scalar_t), intent(in) :: self
+ type(vector_t) :: r
+ r%val = self%val * 2.0
+ end function
+
+ ! .sq. on scalar_t -> scalar_t
+ pure function do_sq (self) result (r)
+ class(scalar_t), intent(in) :: self
+ type(scalar_t) :: r
+ r%val = self%val * self%val
+ end function
+
+ ! .div. on vector_t -> scalar_t
+ pure function do_div (self) result (r)
+ class(vector_t), intent(in) :: self
+ type(scalar_t) :: r
+ r%val = self%val / 2.0
+ end function
+
+ pure function get_val (self) result (r)
+ class(scalar_t), intent(in) :: self
+ real :: r
+ r = self%val
+ end function
+
+end module associate_80_m
+
+program associate_80
+ use associate_80_m
+ implicit none
+
+ type(scalar_t) :: s
+ s%val = 3.0
+
+ ! Case 1: direct type-bound UDO as ASSOCIATE selector
+ associate (g => .grad. s)
+ if (abs (g%val - 6.0) > 1.0e-6) stop 1
+ if (abs (g%get () - 6.0) > 1.0e-6) stop 2
+ end associate
+
+ ! Case 2: inherited UDO (.sq. defined on scalar_t, used via scalar_t)
+ associate (q => .sq. s)
+ if (abs (q%val - 9.0) > 1.0e-6) stop 3
+ end associate
+
+ ! Case 3: nested UDOs — .div. (.grad. s)
+ ! .grad. s gives vector_t with val=6, .div. gives scalar_t with val=3
+ associate (r => .div. (.grad. s))
+ if (abs (r%val - 3.0) > 1.0e-6) stop 4
+ if (abs (r%get () - 3.0) > 1.0e-6) stop 5
+ end associate
+
+end program associate_80
--
2.54.0
