fortran: Evaluate once BACK argument of MINLOC/MAXLOC with DIM [PR90608]

Evaluate the BACK argument of MINLOC/MAXLOC once before the
scalarization loops in the case where the DIM argument is present.

This is a follow-up to r15-1994-ga55d24b3cf7f4d07492bb8e6fcee557175b47ea3
which added knowledge of BACK to the scalarizer, to
r15-2701-ga10436a8404ad2f0cc5aa4d6a0cc850abe5ef49e which removed it to
handle it out of scalarization instead, and to more immediate previous
patches that added inlining support for MINLOC/MAXLOC with DIM.  The
inlining support for MINLOC/MAXLOC with DIM introduced nested loops, which
made the evaluation of BACK (removed from the scalarizer knowledge by the
forementionned commit) wrapped in a loop, so possibly executed more than
once.  This change adds BACK to the scalarization chain if MINLOC/MAXLOC
will use nested loops, so that it is evaluated by the scalarizer only once
before the outermost loop in that case.

	PR fortran/90608

gcc/fortran/ChangeLog:

	* trans-intrinsic.cc
	(walk_inline_intrinsic_minmaxloc): Add a scalar element for BACK as
	first item of the chain if BACK is present and there will be nested
	loops.
	(gfc_conv_intrinsic_minmaxloc): Evaluate BACK using an inherited
	scalarization chain if there is a nested loop.

gcc/testsuite/ChangeLog:

	* gfortran.dg/maxloc_8.f90: New test.
	* gfortran.dg/minloc_9.f90: New test.

1 files changed, 19 insertions, 2 deletions

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 8b4fd8e..14a81fb 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5595,7 +5595,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
     && maskexpr->symtree->n.sym->attr.optional;
   backexpr = back_arg->expr;
 
-  gfc_init_se (&backse, NULL);
+  gfc_init_se (&backse, nested_loop ? se : nullptr);
   if (backexpr == nullptr)
     back = logical_false_node;
   else if (maybe_absent_optional_variable (backexpr))
@@ -11886,10 +11886,13 @@ walk_inline_intrinsic_minmaxloc (gfc_ss *ss, gfc_expr *expr ATTRIBUTE_UNUSED)
   gfc_actual_arglist *array_arg = expr->value.function.actual;
   gfc_actual_arglist *dim_arg = array_arg->next;
   gfc_actual_arglist *mask_arg = dim_arg->next;
+  gfc_actual_arglist *kind_arg = mask_arg->next;
+  gfc_actual_arglist *back_arg = kind_arg->next;
 
   gfc_expr *array = array_arg->expr;
   gfc_expr *dim = dim_arg->expr;
   gfc_expr *mask = mask_arg->expr;
+  gfc_expr *back = back_arg->expr;
 
   if (dim == nullptr)
     return gfc_get_array_ss (ss, expr, 1, GFC_SS_INTRINSIC);
@@ -11917,7 +11920,21 @@ walk_inline_intrinsic_minmaxloc (gfc_ss *ss, gfc_expr *expr ATTRIBUTE_UNUSED)
      chain, "hiding" that dimension from the outer scalarization.  */
   int dim_val = mpz_get_si (dim->value.integer);
   gfc_ss *tail = nest_loop_dimension (tmp_ss, dim_val - 1);
-  tail->next = ss;
+
+  if (back && array->rank > 1)
+    {
+      /* If there are nested scalarization loops, include BACK in the
+	 scalarization chains to avoid evaluating it multiple times in a loop.
+	 Otherwise, prefer to handle it outside of scalarization.  */
+      gfc_ss *back_ss = gfc_get_scalar_ss (ss, back);
+      back_ss->info->type = GFC_SS_REFERENCE;
+      if (maybe_absent_optional_variable (back))
+	back_ss->info->can_be_null_ref = true;
+
+      tail->next = back_ss;
+    }
+  else
+    tail->next = ss;
 
   if (scalar_mask)
     {