[Patch, fortran] PR123352 - invalid association target when invoking type-bound function on associate-name with operator-result selector

[Paul Richard Thomas]

Happy New Year to one and all!

The attached fixes the PR by extending the expression. If the namespace has
not been resolved and the derived type is use associated, resolve the
derived type symbol. This then puts everything in place to find the
specific function for the typebound operator.

Regtests on FC43/x86_64 - OK for mainline?

Paul

Change.Logs
Description: Binary data

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index da007c9ca87..61c0231195e 100644
--- 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 5ffec5074ed..826e56f9d7b 100644
--- 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 666eef4c937..d4134c32578 100644
--- 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 c34fba7a0f5..c7b7817be56 100644
--- 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
index 00000000000..7fded52fa84
--- /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" } }