[PATCH] PR125530 ASSOCIATE with contained-function selector rejecting, type-bound calls

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