fortran: Support optional dummy as BACK argument of MINLOC/MAXLOC.

Protect the evaluation of BACK with a check that the reference is non-null
in case the expression is an optional dummy, in the inline code generated
for MINLOC and MAXLOC.

This change contains a revert of the non-testsuite part of commit
r15-1994-ga55d24b3cf7f4d07492bb8e6fcee557175b47ea3, which factored the
evaluation of BACK out of the loop using the scalarizer.  It was a bad idea,
because delegating the argument evaluation to the scalarizer makes it
cumbersome to add a null pointer check next to the evaluation.

Instead, evaluate BACK at the beginning, before scalarization, add a check
that the argument is present if necessary, and evaluate the resulting
expression to a variable, before using the variable in the inline code.

gcc/fortran/ChangeLog:

	* trans-intrinsic.cc (maybe_absent_optional_variable): New function.
	(gfc_conv_intrinsic_minmaxloc): Remove BACK from scalarization and
	evaluate it before.  Add a check that BACK is not null if the
	expression is an optional dummy.  Save the resulting expression to a
	variable.  Use the variable in the generated inline code.

gcc/testsuite/ChangeLog:

	* gfortran.dg/maxloc_6.f90: New test.
	* gfortran.dg/minloc_7.f90: New test.

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 180d0d7a88c6d703a935edfb584044efac31e581..150cb9ff963b6139a6d7ca0f4b2c903e59fecd10 100644 (file)
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5209,6 +5209,50 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr * expr)
 }
 
 
+/* Tells whether the expression E is a reference to an optional variable whose
+   presence is not known at compile time.  Those are variable references without
+   subreference; if there is a subreference, we can assume the variable is
+   present.  We have to special case full arrays, which we represent with a fake
+   "full" reference, and class descriptors for which a reference to data is not
+   really a subreference.  */
+
+bool
+maybe_absent_optional_variable (gfc_expr *e)
+{
+  if (!(e && e->expr_type == EXPR_VARIABLE))
+    return false;
+
+  gfc_symbol *sym = e->symtree->n.sym;
+  if (!sym->attr.optional)
+    return false;
+
+  gfc_ref *ref = e->ref;
+  if (ref == nullptr)
+    return true;
+
+  if (ref->type == REF_ARRAY
+      && ref->u.ar.type == AR_FULL
+      && ref->next == nullptr)
+    return true;
+
+  if (!(sym->ts.type == BT_CLASS
+       && ref->type == REF_COMPONENT
+       && ref->u.c.component == CLASS_DATA (sym)))
+    return false;
+
+  gfc_ref *next_ref = ref->next;
+  if (next_ref == nullptr)
+    return true;
+
+  if (next_ref->type == REF_ARRAY
+      && next_ref->u.ar.type == AR_FULL
+      && next_ref->next == nullptr)
+    return true;
+
+  return false;
+}
+
+
 /* Remove unneeded kind= argument from actual argument list when the
    result conversion is dealt with in a different place.  */
 
@@ -5321,11 +5365,11 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
   tree nonempty;
   tree lab1, lab2;
   tree b_if, b_else;
+  tree back;
   gfc_loopinfo loop;
   gfc_actual_arglist *actual;
   gfc_ss *arrayss;
   gfc_ss *maskss;
-  gfc_ss *backss;
   gfc_se arrayse;
   gfc_se maskse;
   gfc_expr *arrayexpr;
@@ -5391,10 +5435,29 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
     && maskexpr->symtree->n.sym->attr.dummy
     && maskexpr->symtree->n.sym->attr.optional;
   backexpr = actual->next->next->expr;
-  if (backexpr)
-    backss = gfc_get_scalar_ss (gfc_ss_terminator, backexpr);
+
+  gfc_init_se (&backse, NULL);
+  if (backexpr == nullptr)
+    back = logical_false_node;
+  else if (maybe_absent_optional_variable (backexpr))
+    {
+      /* This should have been checked already by
+        maybe_absent_optional_variable.  */
+      gcc_checking_assert (backexpr->expr_type == EXPR_VARIABLE);
+
+      gfc_conv_expr (&backse, backexpr);
+      tree present = gfc_conv_expr_present (backexpr->symtree->n.sym, false);
+      back = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+                             logical_type_node, present, backse.expr);
+    }
   else
-    backss = nullptr;
+    {
+      gfc_conv_expr (&backse, backexpr);
+      back = backse.expr;
+    }
+  gfc_add_block_to_block (&se->pre, &backse.pre);
+  back = gfc_evaluate_now_loc (input_location, back, &se->pre);
+  gfc_add_block_to_block (&se->pre, &backse.post);
 
   nonempty = NULL;
   if (maskexpr && maskexpr->rank != 0)
@@ -5455,9 +5518,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
   if (maskss)
     gfc_add_ss_to_loop (&loop, maskss);
 
-  if (backss)
-    gfc_add_ss_to_loop (&loop, backss);
-
   gfc_add_ss_to_loop (&loop, arrayss);
 
   /* Initialize the loop.  */
@@ -5543,11 +5603,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
   gfc_conv_expr_val (&arrayse, arrayexpr);
   gfc_add_block_to_block (&block, &arrayse.pre);
 
-  gfc_init_se (&backse, NULL);
-  backse.ss = backss;
-  gfc_conv_expr_val (&backse, backexpr);
-  gfc_add_block_to_block (&block, &backse.pre);
-
   /* We do the following if this is a more extreme value.  */
   gfc_start_block (&ifblock);
 
@@ -5608,7 +5663,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
          elsebody2 = gfc_finish_block (&elseblock);
 
          tmp = fold_build3_loc (input_location, COND_EXPR, logical_type_node,
-                                backse.expr, ifbody2, elsebody2);
+                                back, ifbody2, elsebody2);
 
          gfc_add_expr_to_block (&block, tmp);
        }
@@ -5707,7 +5762,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
        elsebody2 = gfc_finish_block (&elseblock);
 
        tmp = fold_build3_loc (input_location, COND_EXPR, logical_type_node,
-                              backse.expr, ifbody2, elsebody2);
+                              back, ifbody2, elsebody2);
       }
 
       gfc_add_expr_to_block (&block, tmp);

diff --git a/gcc/testsuite/gfortran.dg/maxloc_6.f90 b/gcc/testsuite/gfortran.dg/maxloc_6.f90
new file mode 100644 (file)
index 0000000..d5439b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_6.f90
@@ -0,0 +1,366 @@
+! { dg-do run }
+!
+! Check that the inline implementation of MAXLOC correctly supports indirect
+! MASK, that is a MASK expression that is itself an optional variable.
+
+program p
+  implicit none
+  integer, parameter :: data(*) = (/ 3, 7, 1, 0, 7, 0, 3, 5, 3, 0 /)
+  logical, parameter :: mask(*) = (/ .true. , .false., .true., .true. , &
+                                   & .false., .true. , .true., .false., &
+                                   & .true. , .true. /)
+  call check_int_const_shape_absent_back
+  call check_int_const_shape_false_back
+  call check_int_const_shape_true_back
+  call check_int_const_shape_scalar_mask_absent_back
+  call check_int_const_shape_scalar_mask_false_back
+  call check_int_const_shape_scalar_mask_true_back
+  call check_int_assumed_shape_absent_back
+  call check_int_assumed_shape_false_back
+  call check_int_assumed_shape_true_back
+  call check_int_assumed_shape_scalar_mask_absent_back
+  call check_int_assumed_shape_scalar_mask_false_back
+  call check_int_assumed_shape_scalar_mask_true_back
+  call check_int_func_absent_back
+  call check_int_func_false_back
+  call check_int_func_true_back
+  call check_int_func_scalar_mask_absent_back
+  call check_int_func_scalar_mask_false_back
+  call check_int_func_scalar_mask_true_back
+  call check_int_const_shape_array_mask_absent_back
+  call check_int_const_shape_array_mask_false_back
+  call check_int_const_shape_array_mask_true_back
+  call check_int_assumed_shape_array_mask_absent_back
+  call check_int_assumed_shape_array_mask_false_back
+  call check_int_assumed_shape_array_mask_true_back
+  call check_real_const_shape_absent_back
+  call check_real_const_shape_false_back
+  call check_real_const_shape_true_back
+  call check_real_const_shape_scalar_mask_absent_back
+  call check_real_const_shape_scalar_mask_false_back
+  call check_real_const_shape_scalar_mask_true_back
+  call check_real_assumed_shape_absent_back
+  call check_real_assumed_shape_false_back
+  call check_real_assumed_shape_true_back
+  call check_real_assumed_shape_scalar_mask_absent_back
+  call check_real_assumed_shape_scalar_mask_false_back
+  call check_real_assumed_shape_scalar_mask_true_back
+contains
+  subroutine call_maxloc_int_const_shape(r, a, b)
+    integer :: r, a(10)
+    logical, optional :: b
+    r = maxloc(a, dim = 1, back = b)
+  end subroutine
+  subroutine check_int_const_shape_absent_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_const_shape(r, a)
+    if (r /= 2) stop 9
+  end subroutine
+  subroutine check_int_const_shape_false_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_const_shape(r, a, .false.)
+    if (r /= 2) stop 16
+  end subroutine
+  subroutine check_int_const_shape_true_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_const_shape(r, a, .true.)
+    if (r /= 5) stop 23
+  end subroutine
+  subroutine call_maxloc_int_const_shape_scalar_mask(r, a, m, b)
+    integer :: r, a(10)
+    logical :: m
+    logical, optional :: b
+    r = maxloc(a, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_int_const_shape_scalar_mask_absent_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_const_shape_scalar_mask(r, a, .true.)
+    if (r /= 2) stop 30
+  end subroutine
+  subroutine check_int_const_shape_scalar_mask_false_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_const_shape_scalar_mask(r, a, .true., .false.)
+    if (r /= 2) stop 37
+  end subroutine
+  subroutine check_int_const_shape_scalar_mask_true_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_const_shape_scalar_mask(r, a, .true., .true.)
+    if (r /= 5) stop 44
+  end subroutine
+  subroutine call_maxloc_int_assumed_shape(r, a, b)
+    integer :: r, a(:)
+    logical, optional :: b
+    r = maxloc(a, dim = 1, back = b)
+  end subroutine
+  subroutine check_int_assumed_shape_absent_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_assumed_shape(r, a)
+    if (r /= 2) stop 51
+  end subroutine
+  subroutine check_int_assumed_shape_false_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_assumed_shape(r, a, .false.)
+    if (r /= 2) stop 58
+  end subroutine
+  subroutine check_int_assumed_shape_true_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_assumed_shape(r, a, .true.)
+    if (r /= 5) stop 65
+  end subroutine
+  subroutine call_maxloc_int_assumed_shape_scalar_mask(r, a, m, b)
+    integer :: r, a(:)
+    logical :: m
+    logical, optional :: b
+    r = maxloc(a, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_int_assumed_shape_scalar_mask_absent_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_assumed_shape_scalar_mask(r, a, .true.)
+    if (r /= 2) stop 72
+  end subroutine
+  subroutine check_int_assumed_shape_scalar_mask_false_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_assumed_shape_scalar_mask(r, a, .true., .false.)
+    if (r /= 2) stop 79
+  end subroutine
+  subroutine check_int_assumed_shape_scalar_mask_true_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_assumed_shape_scalar_mask(r, a, .true., .true.)
+    if (r /= 5) stop 86
+  end subroutine
+  function id(a) result(r)
+    integer, dimension(:) :: a
+    integer, dimension(size(a, dim = 1)) :: r
+    r = a
+  end function
+  subroutine call_maxloc_int_func(r, a, b)
+    integer :: r, a(:)
+    logical, optional :: b
+    r = maxloc(id(a) + 1, dim = 1, back = b)
+  end subroutine
+  subroutine check_int_func_absent_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_func(r, a)
+    if (r /= 2) stop 93
+  end subroutine
+  subroutine check_int_func_false_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_func(r, a, .false.)
+    if (r /= 2) stop 100
+  end subroutine
+  subroutine check_int_func_true_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_func(r, a, .true.)
+    if (r /= 5) stop 107
+  end subroutine
+  subroutine call_maxloc_int_func_scalar_mask(r, a, m, b)
+    integer :: r, a(:)
+    logical :: m
+    logical, optional :: b
+    r = maxloc(id(a) + 1, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_int_func_scalar_mask_absent_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_func_scalar_mask(r, a, .true.)
+    if (r /= 2) stop 114
+  end subroutine
+  subroutine check_int_func_scalar_mask_false_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_func_scalar_mask(r, a, .true., .false.)
+    if (r /= 2) stop 121
+  end subroutine
+  subroutine check_int_func_scalar_mask_true_back
+    integer :: r, a(10)
+    a = data
+    call call_maxloc_int_func_scalar_mask(r, a, .true., .true.)
+    if (r /= 5) stop 128
+  end subroutine
+  subroutine call_maxloc_int_const_shape_array_mask(r, a, m, b)
+    integer :: r, a(10)
+    logical :: m(10)
+    logical, optional :: b
+    r = maxloc(a, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_int_const_shape_array_mask_absent_back
+    integer :: r, a(10)
+    logical :: m(10)
+    a = data
+    m = mask
+    call call_maxloc_int_const_shape_array_mask(r, a, m)
+    if (r /= 1) stop 135
+  end subroutine
+  subroutine check_int_const_shape_array_mask_false_back
+    integer :: r, a(10)
+    logical :: m(10)
+    a = data
+    m = mask
+    call call_maxloc_int_const_shape_array_mask(r, a, m, .false.)
+    if (r /= 1) stop 142
+  end subroutine
+  subroutine check_int_const_shape_array_mask_true_back
+    integer :: r, a(10)
+    logical :: m(10)
+    a = data
+    m = mask
+    call call_maxloc_int_const_shape_array_mask(r, a, m, .true.)
+    if (r /= 9) stop 149
+  end subroutine
+  subroutine call_maxloc_int_assumed_shape_array_mask(r, a, m, b)
+    integer :: r, a(:)
+    logical :: m(:)
+    logical, optional :: b
+    r = maxloc(a, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_int_assumed_shape_array_mask_absent_back
+    integer :: r, a(10)
+    logical :: m(10)
+    a = data
+    m = mask
+    call call_maxloc_int_assumed_shape_array_mask(r, a, m)
+    if (r /= 1) stop 156
+  end subroutine
+  subroutine check_int_assumed_shape_array_mask_false_back
+    integer :: r, a(10)
+    logical :: m(10)
+    a = data
+    m = mask
+    call call_maxloc_int_assumed_shape_array_mask(r, a, m, .false.)
+    if (r /= 1) stop 163
+  end subroutine
+  subroutine check_int_assumed_shape_array_mask_true_back
+    integer :: r, a(10)
+    logical :: m(10)
+    a = data
+    m = mask
+    call call_maxloc_int_assumed_shape_array_mask(r, a, m, .true.)
+    if (r /= 9) stop 170
+  end subroutine
+  subroutine call_maxloc_real_const_shape(r, a, b)
+    integer :: r
+    real :: a(10)
+    logical, optional :: b
+    r = maxloc(a, dim = 1, back = b)
+  end subroutine
+  subroutine check_real_const_shape_absent_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_maxloc_real_const_shape(r, a)
+    if (r /= 2) stop 177
+  end subroutine
+  subroutine check_real_const_shape_false_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_maxloc_real_const_shape(r, a, .false.)
+    if (r /= 2) stop 184
+  end subroutine
+  subroutine check_real_const_shape_true_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_maxloc_real_const_shape(r, a, .true.)
+    if (r /= 5) stop 191
+  end subroutine
+  subroutine call_maxloc_real_const_shape_scalar_mask(r, a, m, b)
+    integer :: r
+    real :: a(10)
+    logical :: m
+    logical, optional :: b
+    r = maxloc(a, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_real_const_shape_scalar_mask_absent_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_maxloc_real_const_shape_scalar_mask(r, a, .true.)
+    if (r /= 2) stop 198
+  end subroutine
+  subroutine check_real_const_shape_scalar_mask_false_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_maxloc_real_const_shape_scalar_mask(r, a, .true., .false.)
+    if (r /= 2) stop 205
+  end subroutine
+  subroutine check_real_const_shape_scalar_mask_true_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_maxloc_real_const_shape_scalar_mask(r, a, .true., .true.)
+    if (r /= 5) stop 212
+  end subroutine
+  subroutine call_maxloc_real_assumed_shape(r, a, b)
+    integer :: r
+    real :: a(:)
+    logical, optional :: b
+    r = maxloc(a, dim = 1, back = b)
+  end subroutine
+  subroutine check_real_assumed_shape_absent_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_maxloc_real_assumed_shape(r, a)
+    if (r /= 2) stop 219
+  end subroutine
+  subroutine check_real_assumed_shape_false_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_maxloc_real_assumed_shape(r, a, .false.)
+    if (r /= 2) stop 226
+  end subroutine
+  subroutine check_real_assumed_shape_true_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_maxloc_real_assumed_shape(r, a, .true.)
+    if (r /= 5) stop 233
+  end subroutine
+  subroutine call_maxloc_real_assumed_shape_scalar_mask(r, a, m, b)
+    integer :: r
+    real :: a(:)
+    logical :: m
+    logical, optional :: b
+    r = maxloc(a, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_real_assumed_shape_scalar_mask_absent_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_maxloc_real_assumed_shape_scalar_mask(r, a, .true.)
+    if (r /= 2) stop 240
+  end subroutine
+  subroutine check_real_assumed_shape_scalar_mask_false_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_maxloc_real_assumed_shape_scalar_mask(r, a, .true., .false.)
+    if (r /= 2) stop 247
+  end subroutine
+  subroutine check_real_assumed_shape_scalar_mask_true_back
+    integer :: r
+    real :: a(10)
+    a = data
+    a = (/ real :: data /)
+    call call_maxloc_real_assumed_shape_scalar_mask(r, a, .true., .true.)
+    if (r /= 5) stop 254
+  end subroutine
+end program p

diff --git a/gcc/testsuite/gfortran.dg/minloc_7.f90 b/gcc/testsuite/gfortran.dg/minloc_7.f90
new file mode 100644 (file)
index 0000000..7da77fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minloc_7.f90
@@ -0,0 +1,366 @@
+! { dg-do run }
+!
+! Check that the inline implementation of MINLOC correctly supports indirect
+! MASK, that is a MASK expression that is itself an optional variable.
+
+program p
+  implicit none
+  integer, parameter :: data(*) = (/ 6, 2, 8, 9, 2, 9, 6, 4, 6, 9 /)
+  logical, parameter :: mask(*) = (/ .true. , .false., .true., .true. , &
+                                   & .false., .true. , .true., .false., &
+                                   & .true. , .true. /)
+  call check_int_const_shape_absent_back
+  call check_int_const_shape_false_back
+  call check_int_const_shape_true_back
+  call check_int_const_shape_scalar_mask_absent_back
+  call check_int_const_shape_scalar_mask_false_back
+  call check_int_const_shape_scalar_mask_true_back
+  call check_int_assumed_shape_absent_back
+  call check_int_assumed_shape_false_back
+  call check_int_assumed_shape_true_back
+  call check_int_assumed_shape_scalar_mask_absent_back
+  call check_int_assumed_shape_scalar_mask_false_back
+  call check_int_assumed_shape_scalar_mask_true_back
+  call check_int_func_absent_back
+  call check_int_func_false_back
+  call check_int_func_true_back
+  call check_int_func_scalar_mask_absent_back
+  call check_int_func_scalar_mask_false_back
+  call check_int_func_scalar_mask_true_back
+  call check_int_const_shape_array_mask_absent_back
+  call check_int_const_shape_array_mask_false_back
+  call check_int_const_shape_array_mask_true_back
+  call check_int_assumed_shape_array_mask_absent_back
+  call check_int_assumed_shape_array_mask_false_back
+  call check_int_assumed_shape_array_mask_true_back
+  call check_real_const_shape_absent_back
+  call check_real_const_shape_false_back
+  call check_real_const_shape_true_back
+  call check_real_const_shape_scalar_mask_absent_back
+  call check_real_const_shape_scalar_mask_false_back
+  call check_real_const_shape_scalar_mask_true_back
+  call check_real_assumed_shape_absent_back
+  call check_real_assumed_shape_false_back
+  call check_real_assumed_shape_true_back
+  call check_real_assumed_shape_scalar_mask_absent_back
+  call check_real_assumed_shape_scalar_mask_false_back
+  call check_real_assumed_shape_scalar_mask_true_back
+contains
+  subroutine call_minloc_int_const_shape(r, a, b)
+    integer :: r, a(10)
+    logical, optional :: b
+    r = minloc(a, dim = 1, back = b)
+  end subroutine
+  subroutine check_int_const_shape_absent_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_const_shape(r, a)
+    if (r /= 2) stop 9
+  end subroutine
+  subroutine check_int_const_shape_false_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_const_shape(r, a, .false.)
+    if (r /= 2) stop 16
+  end subroutine
+  subroutine check_int_const_shape_true_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_const_shape(r, a, .true.)
+    if (r /= 5) stop 23
+  end subroutine
+  subroutine call_minloc_int_const_shape_scalar_mask(r, a, m, b)
+    integer :: r, a(10)
+    logical :: m
+    logical, optional :: b
+    r = minloc(a, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_int_const_shape_scalar_mask_absent_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_const_shape_scalar_mask(r, a, .true.)
+    if (r /= 2) stop 30
+  end subroutine
+  subroutine check_int_const_shape_scalar_mask_false_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_const_shape_scalar_mask(r, a, .true., .false.)
+    if (r /= 2) stop 37
+  end subroutine
+  subroutine check_int_const_shape_scalar_mask_true_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_const_shape_scalar_mask(r, a, .true., .true.)
+    if (r /= 5) stop 44
+  end subroutine
+  subroutine call_minloc_int_assumed_shape(r, a, b)
+    integer :: r, a(:)
+    logical, optional :: b
+    r = minloc(a, dim = 1, back = b)
+  end subroutine
+  subroutine check_int_assumed_shape_absent_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_assumed_shape(r, a)
+    if (r /= 2) stop 51
+  end subroutine
+  subroutine check_int_assumed_shape_false_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_assumed_shape(r, a, .false.)
+    if (r /= 2) stop 58
+  end subroutine
+  subroutine check_int_assumed_shape_true_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_assumed_shape(r, a, .true.)
+    if (r /= 5) stop 65
+  end subroutine
+  subroutine call_minloc_int_assumed_shape_scalar_mask(r, a, m, b)
+    integer :: r, a(:)
+    logical :: m
+    logical, optional :: b
+    r = minloc(a, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_int_assumed_shape_scalar_mask_absent_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_assumed_shape_scalar_mask(r, a, .true.)
+    if (r /= 2) stop 72
+  end subroutine
+  subroutine check_int_assumed_shape_scalar_mask_false_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_assumed_shape_scalar_mask(r, a, .true., .false.)
+    if (r /= 2) stop 79
+  end subroutine
+  subroutine check_int_assumed_shape_scalar_mask_true_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_assumed_shape_scalar_mask(r, a, .true., .true.)
+    if (r /= 5) stop 86
+  end subroutine
+  function id(a) result(r)
+    integer, dimension(:) :: a
+    integer, dimension(size(a, dim = 1)) :: r
+    r = a
+  end function
+  subroutine call_minloc_int_func(r, a, b)
+    integer :: r, a(:)
+    logical, optional :: b
+    r = minloc(id(a) + 1, dim = 1, back = b)
+  end subroutine
+  subroutine check_int_func_absent_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_func(r, a)
+    if (r /= 2) stop 93
+  end subroutine
+  subroutine check_int_func_false_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_func(r, a, .false.)
+    if (r /= 2) stop 100
+  end subroutine
+  subroutine check_int_func_true_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_func(r, a, .true.)
+    if (r /= 5) stop 107
+  end subroutine
+  subroutine call_minloc_int_func_scalar_mask(r, a, m, b)
+    integer :: r, a(:)
+    logical :: m
+    logical, optional :: b
+    r = minloc(id(a) + 1, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_int_func_scalar_mask_absent_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_func_scalar_mask(r, a, .true.)
+    if (r /= 2) stop 114
+  end subroutine
+  subroutine check_int_func_scalar_mask_false_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_func_scalar_mask(r, a, .true., .false.)
+    if (r /= 2) stop 121
+  end subroutine
+  subroutine check_int_func_scalar_mask_true_back
+    integer :: r, a(10)
+    a = data
+    call call_minloc_int_func_scalar_mask(r, a, .true., .true.)
+    if (r /= 5) stop 128
+  end subroutine
+  subroutine call_minloc_int_const_shape_array_mask(r, a, m, b)
+    integer :: r, a(10)
+    logical :: m(10)
+    logical, optional :: b
+    r = minloc(a, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_int_const_shape_array_mask_absent_back
+    integer :: r, a(10)
+    logical :: m(10)
+    a = data
+    m = mask
+    call call_minloc_int_const_shape_array_mask(r, a, m)
+    if (r /= 1) stop 135
+  end subroutine
+  subroutine check_int_const_shape_array_mask_false_back
+    integer :: r, a(10)
+    logical :: m(10)
+    a = data
+    m = mask
+    call call_minloc_int_const_shape_array_mask(r, a, m, .false.)
+    if (r /= 1) stop 142
+  end subroutine
+  subroutine check_int_const_shape_array_mask_true_back
+    integer :: r, a(10)
+    logical :: m(10)
+    a = data
+    m = mask
+    call call_minloc_int_const_shape_array_mask(r, a, m, .true.)
+    if (r /= 9) stop 149
+  end subroutine
+  subroutine call_minloc_int_assumed_shape_array_mask(r, a, m, b)
+    integer :: r, a(:)
+    logical :: m(:)
+    logical, optional :: b
+    r = minloc(a, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_int_assumed_shape_array_mask_absent_back
+    integer :: r, a(10)
+    logical :: m(10)
+    a = data
+    m = mask
+    call call_minloc_int_assumed_shape_array_mask(r, a, m)
+    if (r /= 1) stop 156
+  end subroutine
+  subroutine check_int_assumed_shape_array_mask_false_back
+    integer :: r, a(10)
+    logical :: m(10)
+    a = data
+    m = mask
+    call call_minloc_int_assumed_shape_array_mask(r, a, m, .false.)
+    if (r /= 1) stop 163
+  end subroutine
+  subroutine check_int_assumed_shape_array_mask_true_back
+    integer :: r, a(10)
+    logical :: m(10)
+    a = data
+    m = mask
+    call call_minloc_int_assumed_shape_array_mask(r, a, m, .true.)
+    if (r /= 9) stop 170
+  end subroutine
+  subroutine call_minloc_real_const_shape(r, a, b)
+    integer :: r
+    real :: a(10)
+    logical, optional :: b
+    r = minloc(a, dim = 1, back = b)
+  end subroutine
+  subroutine check_real_const_shape_absent_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_minloc_real_const_shape(r, a)
+    if (r /= 2) stop 177
+  end subroutine
+  subroutine check_real_const_shape_false_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_minloc_real_const_shape(r, a, .false.)
+    if (r /= 2) stop 184
+  end subroutine
+  subroutine check_real_const_shape_true_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_minloc_real_const_shape(r, a, .true.)
+    if (r /= 5) stop 191
+  end subroutine
+  subroutine call_minloc_real_const_shape_scalar_mask(r, a, m, b)
+    integer :: r
+    real :: a(10)
+    logical :: m
+    logical, optional :: b
+    r = minloc(a, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_real_const_shape_scalar_mask_absent_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_minloc_real_const_shape_scalar_mask(r, a, .true.)
+    if (r /= 2) stop 198
+  end subroutine
+  subroutine check_real_const_shape_scalar_mask_false_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_minloc_real_const_shape_scalar_mask(r, a, .true., .false.)
+    if (r /= 2) stop 205
+  end subroutine
+  subroutine check_real_const_shape_scalar_mask_true_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_minloc_real_const_shape_scalar_mask(r, a, .true., .true.)
+    if (r /= 5) stop 212
+  end subroutine
+  subroutine call_minloc_real_assumed_shape(r, a, b)
+    integer :: r
+    real :: a(:)
+    logical, optional :: b
+    r = minloc(a, dim = 1, back = b)
+  end subroutine
+  subroutine check_real_assumed_shape_absent_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_minloc_real_assumed_shape(r, a)
+    if (r /= 2) stop 219
+  end subroutine
+  subroutine check_real_assumed_shape_false_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_minloc_real_assumed_shape(r, a, .false.)
+    if (r /= 2) stop 226
+  end subroutine
+  subroutine check_real_assumed_shape_true_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_minloc_real_assumed_shape(r, a, .true.)
+    if (r /= 5) stop 233
+  end subroutine
+  subroutine call_minloc_real_assumed_shape_scalar_mask(r, a, m, b)
+    integer :: r
+    real :: a(:)
+    logical :: m
+    logical, optional :: b
+    r = minloc(a, dim = 1, mask = m, back = b)
+  end subroutine
+  subroutine check_real_assumed_shape_scalar_mask_absent_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_minloc_real_assumed_shape_scalar_mask(r, a, .true.)
+    if (r /= 2) stop 240
+  end subroutine
+  subroutine check_real_assumed_shape_scalar_mask_false_back
+    integer :: r
+    real :: a(10)
+    a = (/ real :: data /)
+    call call_minloc_real_assumed_shape_scalar_mask(r, a, .true., .false.)
+    if (r /= 2) stop 247
+  end subroutine
+  subroutine check_real_assumed_shape_scalar_mask_true_back
+    integer :: r
+    real :: a(10)
+    a = data
+    a = (/ real :: data /)
+    call call_minloc_real_assumed_shape_scalar_mask(r, a, .true., .true.)
+    if (r /= 5) stop 254
+  end subroutine
+end program p