Hi Jerry,
I have refactored the patch somewhat in the attached to keep match.cc
clean and push all the operator expansion to intrinsic.cc.
Either version LGTM and both pass regression testing. OK for mainline
and eventual backporting.
Thanks!
Paul
On Wed, 3 Jun 2026 at 17:51, Jerry D <[email protected]> wrote:
>
> polite PING, I prefer to get this pushed before I push 125529 so I can keep my
> worktree sane
>
> On 6/1/26 4:50 PM, Jerry D wrote:
> > 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.
> > ---
>
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/interface.cc b/gcc/fortran/interface.cc
index b8f4087ef49..3abee0ddb19 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -5019,17 +5019,16 @@ build_compcall_for_operator (gfc_expr* e, gfc_actual_arglist* actual,
}
-/* This subroutine is called when an expression is being resolved.
- The expression node in question is either a user defined operator
- or an intrinsic operator with arguments that aren't compatible
- with the operator. This subroutine builds an actual argument list
+/* This subroutine is called when an expression node in is either a
+ user defined operator or an intrinsic operator with arguments that
+ aren't compatible. 'extend_expr' builds an actual argument list
corresponding to the operands, then searches for a compatible
interface. If one is found, the expression node is replaced with
the appropriate function call. We use the 'match' enum to specify
whether a replacement has been made or not, or if an error occurred. */
-match
-gfc_extend_expr (gfc_expr *e)
+static match
+extend_expr (gfc_expr *e)
{
gfc_actual_arglist *actual;
gfc_symbol *sym;
@@ -5180,6 +5179,194 @@ gfc_extend_expr (gfc_expr *e)
}
+/* Try to resolve an EXPR_FUNCTION operand so its return type is known.
+ Called 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 could be in the parsing phase. */
+
+static void
+resolve_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 extension of nested ops 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_op (gfc_expr *e)
+{
+ if (!e || e->expr_type != EXPR_OP)
+ return;
+
+ /* Bottom-up: process children first. */
+ extend_op (e->value.op.op1);
+ extend_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_operand (e->value.op.op1);
+ resolve_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
+gfc_extend_expr (gfc_expr *expr)
+{
+ match m;
+ m = extend_expr (expr);
+
+ /* If the expression is an unresolved type-bound user-defined operator
+ expression, try to extend it now so the expression gets a usable
+ type. For nested operators such as
+ (.div. (.grad. x))
+ first propagate types bottom-up through the inner operands
+ (extend_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_operand). Then call gfc_extend_expr on the
+ outermost operator. Only handle INTRINSIC_USER here; arithmetic
+ operators are left to the normal resolution pass. */
+ if (m == MATCH_YES
+ && expr->expr_type == EXPR_OP
+ && expr->value.op.op == INTRINSIC_USER)
+ {
+ extend_op (expr->value.op.op1);
+ extend_op (expr->value.op.op2);
+ resolve_operand (expr->value.op.op1);
+ resolve_operand (expr->value.op.op2);
+ /* Suppress errors from extend_expr just in case this call is made
+ while parsing. */
+ gfc_push_suppress_errors ();
+ m = extend_expr (expr);
+ gfc_pop_suppress_errors ();
+ }
+
+ return m;
+}
+
+
/* Tries to replace an assignment code node with a subroutine call to the
subroutine associated with the assignment operator. Return true if the node
was replaced. On false, no error is generated. */
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index d892a4588b2..7356e092b07 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -1980,6 +1980,7 @@ check_coarray_assoc (const char *name, gfc_association_list *assoc)
return true;
}
+
match
match_association_list (bool for_change_team = false)
{
@@ -2144,10 +2145,9 @@ 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)
+ gfc_expr *tmp = gfc_copy_expr (newAssoc->target);
+ match m = gfc_extend_expr (tmp);
+ if (m == MATCH_YES && 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;
