Fortran: Invalid association with operator-result selector [PR123352]

2026-01-03  Paul Thomas  <pault@gcc.gnu.org>

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 --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cd81ac0398c5b1c3a63173a07302006e7902c7b1..cafd3ab53fef147b26d4c7c88c96c8736dfac13c 100644 (file)
--- 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 a25e7b91a5ae9fe3a2b7557680c95dd6d4bbb821..d29cb3a3b82bd138e9dff48678af37db57127019 100644 (file)
--- 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 1655e84f8163889dd2d5fe5687df385ac4172785..64bfeb0918906093519cd7f3cb583e57d28e6081 100644 (file)
--- 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 922f16d9eb682ec2bdc0cc5cce037e8e4182046d..33a183e74146617dd689b1f8c096ad86bae8dd5f 100644 (file)
--- 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 (file)
index 0000000..7fded52
--- /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  <damian@archaeologic.codes>
+!
+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" } }