See the attached patch.
Regression tested on x86_64.
I think the comments are clearer on this one. I have learned to edit out the
verbosity.
OK for mainline and later 16?
Regards,
Jerry
---
Two issues prevented ASSOCIATE constructs whose selector is a call to a
contained function from subsequently calling type-bound procedures on the
associate name.
When the selector is a contained function, resolving it
at parse time (before CONTAINS is fully processed) prematurely set the
function's attribute to FL_PROCEDURE/EXTERNAL, conflicting with its later
declaration as an internal procedure and giving a spurious "attribute
conflict" error.
When the first access is a generic type-bound procedure name, no candidate
type was found, and the associate name got no type, giving "no IMPLICIT type".
Now also search type-bound procedure names via gfc_find_typebound_proc; exclude
vtable types to avoid false positives.
Assisted by: Claude Sonnet 4.6
PR fortran/125530
gcc/fortran/ChangeLog:
* match.cc (gfc_match_call): Route ASSOCIATE names followed by '%'
to match_typebound_call without first resolving the selector, to
avoid prematurely marking a contained-function selector as EXTERNAL.
* symbol.cc (find_derived_types): Also search type-bound procedure
names via gfc_find_typebound_proc when inferring the type of an
inferred-type ASSOCIATE name; exclude vtable types.
gcc/testsuite/ChangeLog:
* gfortran.dg/associate_contained_func_typebound.f90: New test.
---From ac1f9f2f1dec527d11b8908c140eae77b1f77935 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Fri, 5 Jun 2026 10:20:36 -0700
Subject: [PATCH] fortran: ASSOCIATE with contained-function selector rejecting
type-bound calls
Two issues prevented ASSOCIATE constructs whose selector is a call to a
contained function from subsequently calling type-bound procedures on the
associate name.
When the selector is a contained function, resolving it
at parse time (before CONTAINS is fully processed) prematurely set the
function's attribute to FL_PROCEDURE/EXTERNAL, conflicting with its later
declaration as an internal procedure and giving a spurious "attribute
conflict" error.
When the first access is a generic type-bound procedure name, no candidate
type was found, and the associate name got no type, giving "no IMPLICIT type".
Now also search type-bound procedure names via gfc_find_typebound_proc; exclude vtable
types to avoid false positives.
Assisted by: Claude Sonnet 4.6
PR fortran/125530
gcc/fortran/ChangeLog:
* match.cc (gfc_match_call): Route ASSOCIATE names followed by '%'
to match_typebound_call without first resolving the selector, to
avoid prematurely marking a contained-function selector as EXTERNAL.
* symbol.cc (find_derived_types): Also search type-bound procedure
names via gfc_find_typebound_proc when inferring the type of an
inferred-type ASSOCIATE name; exclude vtable types.
gcc/testsuite/ChangeLog:
* gfortran.dg/associate_contained_func_typebound.f90: New test.
---
gcc/fortran/match.cc | 18 ++++---
gcc/fortran/symbol.cc | 6 ++-
.../associate_contained_func_typebound.f90 | 54 +++++++++++++++++++
3 files changed, 71 insertions(+), 7 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/associate_contained_func_typebound.f90
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 9172f46ed7c..614d4dab152 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -6028,12 +6028,18 @@ gfc_match_call (void)
target type. */
if (((sym->attr.flavor != FL_PROCEDURE
|| gfc_is_function_return_value (sym, gfc_current_ns))
- && (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS))
- ||
- (sym->assoc && sym->assoc->target
- && gfc_resolve_expr (sym->assoc->target)
- && (sym->assoc->target->ts.type == BT_DERIVED
- || sym->assoc->target->ts.type == BT_CLASS)))
+ && (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS))
+ ||
+ /* Skip gfc_resolve_expr for ASSOCIATE names followed by '%'.
+ resolving a contained-function selector before CONTAINS is
+ parsed prematurely, marks it EXTERNAL, conflicting with its
+ later INTERNAL declaration. */
+ (sym->assoc && sym->assoc->target && gfc_peek_ascii_char () == '%')
+ ||
+ (sym->assoc && sym->assoc->target
+ && gfc_resolve_expr (sym->assoc->target)
+ && (sym->assoc->target->ts.type == BT_DERIVED
+ || sym->assoc->target->ts.type == BT_CLASS)))
return match_typebound_call (st);
/* If it does not seem to be callable (include functions so that the
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index d2e93755c53..5a224be9884 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -2493,7 +2493,11 @@ find_derived_types (gfc_symbol *sym, gfc_symtree *st, const char *name,
if (st->n.sym && st->n.sym->attr.flavor == FL_DERIVED
&& !st->n.sym->attr.is_class
&& ((contained && st->n.sym->attr.use_assoc) || !contained)
- && gfc_find_component (st->n.sym, name, true, true, NULL))
+ && !st->n.sym->attr.vtype
+ && (gfc_find_component (st->n.sym, name, true, true, NULL)
+ || (st->n.sym->f2k_derived
+ && gfc_find_typebound_proc (st->n.sym, NULL, name, true,
+ NULL))))
{
/* Do the stashing, if required. */
cts++;
diff --git a/gcc/testsuite/gfortran.dg/associate_contained_func_typebound.f90 b/gcc/testsuite/gfortran.dg/associate_contained_func_typebound.f90
new file mode 100644
index 00000000000..f7144717349
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_contained_func_typebound.f90
@@ -0,0 +1,54 @@
+! { dg-do compile }
+! { dg-options "" }
+!
+! PR fortran/125530
+! ASSOCIATE with a contained-function selector giving spurious errors when
+! type-bound (including generic) procedures are called on the associate name.
+
+module tbp_m
+ implicit none
+ type :: t
+ integer :: n = 0
+ contains
+ procedure :: direct_call
+ procedure :: target_of_generic
+ generic :: generic_call => target_of_generic
+ end type
+contains
+ subroutine direct_call (self)
+ class(t), intent(in) :: self
+ print *, self%n
+ end subroutine
+ subroutine target_of_generic (self)
+ class(t), intent(in) :: self
+ print *, self%n
+ end subroutine
+end module
+
+! Direct type-bound call.
+subroutine test_direct ()
+ use tbp_m
+ implicit none
+ associate (x => make_t())
+ call x%direct_call()
+ end associate
+contains
+ function make_t() result(r)
+ type(t) :: r
+ r%n = 1
+ end function
+end subroutine
+
+! Generic type-bound call.
+subroutine test_generic ()
+ use tbp_m
+ implicit none
+ associate (x => make_t())
+ call x%generic_call()
+ end associate
+contains
+ function make_t() result(r)
+ type(t) :: r
+ r%n = 2
+ end function
+end subroutine
--
2.54.0
