fortran: ICE for ASSOCIATE selector that is an overloaded intrinsic operator

Add a fallback branch in match_association_list that, for any remaining
unresolved EXPR_OP selector with BT_UNKNOWN type, calls gfc_extend_expr
to resolve the overloaded operator to its function call early, so the
associate name receives a usable type before the body is parsed.  The
INTRINSIC_USER path is unchanged.

Assisted by: Claude Sonnet 4.6

	PR fortran/125650

gcc/fortran/ChangeLog:

	* match.cc (match_association_list): Handle ASSOCIATE selectors
	that are overloaded intrinsic operator expressions by extending
	them with gfc_extend_expr at parse time, so the associate name is
	typed before the construct body is parsed.

gcc/testsuite/ChangeLog:

	* gfortran.dg/associate_81.f90: New test.

(cherry picked from commit 0ae0849b54aac359e0f67b3fe2767c3739bd6495)

diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 24c872de4bbd0162a2e4d6ac6d030f191b30f7ba..ef6be2d24962a475f3cade5547371bed53718ab3 100644 (file)
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -2326,6 +2326,21 @@ match_association_list (bool for_change_team = false)
          else
            gfc_free_expr (tmp);
        }
+      else if (newAssoc->target->ts.type == BT_UNKNOWN
+              && newAssoc->target->expr_type == EXPR_OP)
+       {
+         /* The selector is an unresolved expression involving an overloaded
+            intrinsic operator (e.g. a `+' bound via an explicit interface
+            to a function returning CHARACTER).  Try to extend it now, the
+            same way the type-bound user-defined operator case above does
+            for INTRINSIC_USER, so the associate name gets a usable type
+            before the body of the ASSOCIATE construct is parsed.  */
+         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/testsuite/gfortran.dg/associate_81.f90 b/gcc/testsuite/gfortran.dg/associate_81.f90
new file mode 100644 (file)
index 0000000..a691aee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_81.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+!
+! PR fortran/125650
+!
+! Verify that an ASSOCIATE selector that is an overloaded intrinsic operator
+! expression (here a CHARACTER-returning `+', bound via an explicit
+! interface) is extended to a function call early enough that the
+! associate name receives a known type before the body of the ASSOCIATE
+! construct is parsed.  Previously the associate name stayed untyped,
+! a substring reference to it was matched incorrectly, and the wrong
+! reference reached the back end, causing an ICE in trans-expr.cc.
+
+module associate_81_m
+  implicit none
+
+  interface operator(+)
+    module procedure concat
+  end interface
+
+contains
+
+  function concat (dd1, dd2)
+    implicit none
+    character(len = 8) :: concat
+    character(len = 3), intent(in) :: dd1
+    character(len = 5), intent(in) :: dd2
+    concat = dd1 // dd2
+  end function
+
+end module
+
+program associate_81
+  use associate_81_m
+  implicit none
+
+  character(len = 3) :: arg1 = 'aaa'
+  character(len = 5) :: arg2 = 'ccccc'
+
+  associate (aa => arg1, bb => arg2, cc => arg1 + arg2)
+    if (cc /= 'aaaccccc') stop 1
+    if (cc(3:5) /= 'acc') stop 2
+  end associate
+
+end program