diff mbox series

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

Message ID 20241014150816.315478-8-morin-mikael@orange.fr
State New
Headers show
Series fortran: Inline MINLOC/MAXLOC with DIM [PR90608] | expand

Commit Message

Mikael Morin Oct. 14, 2024, 3:08 p.m. UTC 
From: Mikael Morin <mikael@gcc.gnu.org>

Bootstrapped and regression-tested on x86_64-pc-linux-gnu.
OK for master?

-- >8 --

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.
---
 gcc/fortran/trans-intrinsic.cc         |  21 +-
 gcc/testsuite/gfortran.dg/maxloc_8.f90 | 349 +++++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/minloc_9.f90 | 349 +++++++++++++++++++++++++
 3 files changed, 717 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/maxloc_8.f90
 create mode 100644 gcc/testsuite/gfortran.dg/minloc_9.f90
diff mbox series

Patch

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index e1a5fdef26c..4cd4f4b1977 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5594,7 +5594,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))
@@ -11885,10 +11885,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);
@@ -11916,7 +11919,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)
     {
diff --git a/gcc/testsuite/gfortran.dg/maxloc_8.f90 b/gcc/testsuite/gfortran.dg/maxloc_8.f90
new file mode 100644
index 00000000000..20f63a84bbe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_8.f90
@@ -0,0 +1,349 @@ 
+! { dg-do run }
+!
+! PR fortran/90608
+! Check that the evaluation of MAXLOC's BACK argument is made only once
+! before the scalarization loops, when the DIM argument is present.
+
+program p
+  implicit none
+  integer, parameter :: data60(*) = (/ 7, 4, 5, 3, 9, 0, 6, 4, 5, 5,  &
+                                       8, 2, 6, 7, 8, 7, 4, 5, 3, 9,  &
+                                       0, 6, 4, 5, 5, 8, 2, 6, 7, 8,  &
+                                       7, 4, 5, 3, 9, 0, 6, 4, 5, 5,  &
+                                       8, 2, 6, 7, 8, 7, 4, 5, 3, 9,  &
+                                       0, 6, 4, 5, 5, 8, 2, 6, 7, 8  /)
+  logical, parameter :: mask60(*) = (/ .true. , .false., .false., .false., &
+                                       .true. , .false., .true. , .false., &
+                                       .false., .true. , .true. , .false., &
+                                       .true. , .true. , .true. , .true. , &
+                                       .false., .true. , .false., .true. , &
+                                       .false., .true. , .false., .true. , &
+                                       .true. , .false., .false., .true. , &
+                                       .true. , .true. , .true. , .false., &
+                                       .false., .false., .true. , .false., &
+                                       .true. , .false., .true. , .true. , &
+                                       .true. , .false., .true. , .true. , &
+                                       .false., .true. , .false., .true. , &
+                                       .false., .true. , .false., .false., &
+                                       .false., .true. , .true. , .true. , &
+                                       .false., .true. , .false., .true.  /)
+  integer :: calls_count = 0
+  call check_int_const_shape_rank_3
+  call check_int_const_shape_rank_3_scalar_mask
+  call check_int_const_shape_rank_3_optional_mask_present
+  call check_int_const_shape_rank_3_optional_mask_absent
+  call check_int_const_shape_rank_3_array_mask
+  call check_int_const_shape_empty_4
+  call check_int_alloc_rank_3
+  call check_int_alloc_rank_3_scalar_mask
+  call check_int_alloc_rank_3_array_mask
+  call check_int_alloc_empty_4
+  call check_real_const_shape_rank_3
+  call check_real_const_shape_rank_3_scalar_mask
+  call check_real_const_shape_rank_3_optional_mask_present
+  call check_real_const_shape_rank_3_optional_mask_absent
+  call check_real_const_shape_rank_3_array_mask
+  call check_real_const_shape_empty_4
+  call check_real_alloc_rank_3
+  call check_real_alloc_rank_3_scalar_mask
+  call check_real_alloc_rank_3_array_mask
+  call check_real_alloc_empty_4
+contains
+  function get_scalar_false()
+    logical :: get_scalar_false
+    calls_count = calls_count + 1
+    get_scalar_false = .false.
+  end function
+  subroutine check_int_const_shape_rank_3()
+    integer :: a(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape(data60, shape(a))
+    calls_count = 0
+    r = maxloc(a, dim = 1, back = get_scalar_false())
+    if (calls_count /= 1) error stop 12
+    r = maxloc(a, dim = 2, back = get_scalar_false())
+    if (calls_count /= 2) error stop 15
+    r = maxloc(a, dim = 3, back = get_scalar_false())
+    if (calls_count /= 3) error stop 18
+  end subroutine
+  subroutine check_int_const_shape_rank_3_scalar_mask()
+    integer :: a(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape(data60, shape(a))
+    calls_count = 0
+    ! We only check the case of a .true. mask.
+    ! If the mask is .false., the back argument is not necessary to deduce
+    ! the value returned by maxloc, so the compiler is free to elide it,
+    ! and the value of calls_count is undefined in that case.
+    r = maxloc(a, dim = 1, mask = .true., back = get_scalar_false())
+    if (calls_count /= 1) error stop 22
+    r = maxloc(a, dim = 2, mask = .true., back = get_scalar_false())
+    if (calls_count /= 2) error stop 25
+    r = maxloc(a, dim = 3, mask = .true., back = get_scalar_false())
+    if (calls_count /= 3) error stop 28
+  end subroutine
+  subroutine call_maxloc_int(r, a, m, b)
+    integer :: a(:,:,:)
+    logical, optional :: m(:,:,:)
+    logical, optional :: b
+    integer, allocatable :: r(:,:)
+    r = maxloc(a, dim = 2, mask = m, back = b)
+  end subroutine
+  subroutine check_int_const_shape_rank_3_optional_mask_present()
+    integer :: a(3,4,5)
+    logical :: m(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape(data60, shape(a))
+    m = reshape(mask60, shape(m))
+    calls_count = 0
+    call call_maxloc_int(r, a, m, get_scalar_false())
+    if (calls_count /= 1) error stop 45
+  end subroutine
+  subroutine check_int_const_shape_rank_3_optional_mask_absent()
+    integer :: a(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape(data60, shape(a))
+    calls_count = 0
+    call call_maxloc_int(r, a, b = get_scalar_false())
+    if (calls_count /= 1) error stop 55
+  end subroutine
+  subroutine check_int_const_shape_rank_3_array_mask()
+    integer :: a(3,4,5)
+    logical :: m(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape(data60, shape(a))
+    m = reshape(mask60, shape(m))
+    calls_count = 0
+    r = maxloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 62
+    r = maxloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 65
+    r = maxloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 68
+  end subroutine
+  subroutine check_int_const_shape_empty_4()
+    integer :: a(9,3,0,7)
+    logical :: m(9,3,0,7)
+    integer, allocatable :: r(:,:,:)
+    a = reshape((/ integer:: /), shape(a))
+    m = reshape((/ logical:: /), shape(m))
+    calls_count = 0
+    r = maxloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 72
+    r = maxloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 74
+    r = maxloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 76
+    r = maxloc(a, dim = 4, mask = m, back = get_scalar_false())
+    if (calls_count /= 4) error stop 78
+  end subroutine
+  subroutine check_int_alloc_rank_3()
+    integer, allocatable :: a(:,:,:)
+    integer, allocatable :: r(:,:)
+    allocate(a(3,4,5))
+    a(:,:,:) = reshape(data60, shape(a))
+    calls_count = 0
+    r = maxloc(a, dim = 1, back = get_scalar_false())
+    if (calls_count /= 1) error stop 82
+    r = maxloc(a, dim = 2, back = get_scalar_false())
+    if (calls_count /= 2) error stop 85
+    r = maxloc(a, dim = 3, back = get_scalar_false())
+    if (calls_count /= 3) error stop 88
+  end subroutine
+  subroutine check_int_alloc_rank_3_scalar_mask()
+    integer, allocatable :: a(:,:,:)
+    integer, allocatable :: r(:,:)
+    allocate(a(3,4,5))
+    a(:,:,:) = reshape(data60, shape(a))
+    calls_count = 0
+    ! We only check the case of a .true. mask.
+    ! If the mask is .false., the back argument is not necessary to deduce
+    ! the value returned by maxloc, so the compiler is free to elide it,
+    ! and the value of calls_count is undefined in that case.
+    r = maxloc(a, dim = 1, mask = .true., back = get_scalar_false())
+    if (calls_count /= 1) error stop 92
+    r = maxloc(a, dim = 2, mask = .true., back = get_scalar_false())
+    if (calls_count /= 2) error stop 95
+    r = maxloc(a, dim = 3, mask = .true., back = get_scalar_false())
+    if (calls_count /= 3) error stop 98
+  end subroutine
+  subroutine check_int_alloc_rank_3_array_mask()
+    integer, allocatable :: a(:,:,:)
+    logical, allocatable :: m(:,:,:)
+    integer, allocatable :: r(:,:)
+    allocate(a(3,4,5), m(3,4,5))
+    a(:,:,:) = reshape(data60, shape(a))
+    m(:,:,:) = reshape(mask60, shape(m))
+    calls_count = 0
+    r = maxloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 102
+    r = maxloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 105
+    r = maxloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 108
+  end subroutine
+  subroutine check_int_alloc_empty_4()
+    integer, allocatable :: a(:,:,:,:)
+    logical, allocatable :: m(:,:,:,:)
+    integer, allocatable :: r(:,:,:)
+    allocate(a(9,3,0,7), m(9,3,0,7))
+    a(:,:,:,:) = reshape((/ integer:: /), shape(a))
+    m(:,:,:,:) = reshape((/ logical:: /), shape(m))
+    calls_count = 0
+    r = maxloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 112
+    r = maxloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 114
+    r = maxloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 116
+    r = maxloc(a, dim = 4, mask = m, back = get_scalar_false())
+    if (calls_count /= 4) error stop 118
+  end subroutine
+  subroutine check_real_const_shape_rank_3()
+    real :: a(3,4,5)
+    logical :: m(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape((/ real:: data60 /), shape(a))
+    m = reshape(mask60, shape(m))
+    calls_count = 0
+    r = maxloc(a, dim = 1, back = get_scalar_false())
+    if (calls_count /= 1) error stop 122
+    r = maxloc(a, dim = 2, back = get_scalar_false())
+    if (calls_count /= 2) error stop 125
+    r = maxloc(a, dim = 3, back = get_scalar_false())
+    if (calls_count /= 3) error stop 128
+  end subroutine
+  subroutine check_real_const_shape_rank_3_scalar_mask()
+    real :: a(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape((/ real:: data60 /), shape(a))
+    calls_count = 0
+    ! We only check the case of a .true. mask.
+    ! If the mask is .false., the back argument is not necessary to deduce
+    ! the value returned by maxloc, so the compiler is free to elide it,
+    ! and the value of calls_count is undefined in that case.
+    r = maxloc(a, dim = 1, mask = .true., back = get_scalar_false())
+    if (calls_count /= 1) error stop 132
+    r = maxloc(a, dim = 2, mask = .true., back = get_scalar_false())
+    if (calls_count /= 2) error stop 135
+    r = maxloc(a, dim = 3, mask = .true., back = get_scalar_false())
+    if (calls_count /= 3) error stop 138
+  end subroutine
+  subroutine check_real_const_shape_rank_3_array_mask()
+    real :: a(3,4,5)
+    logical :: m(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape((/ real:: data60 /), shape(a))
+    m = reshape(mask60, shape(m))
+    calls_count = 0
+    r = maxloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 142
+    r = maxloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 145
+    r = maxloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 148
+  end subroutine
+  subroutine call_maxloc_real(r, a, m, b)
+    real :: a(:,:,:)
+    logical, optional :: m(:,:,:)
+    logical, optional :: b
+    integer, allocatable :: r(:,:)
+    r = maxloc(a, dim = 2, mask = m, back = b)
+  end subroutine
+  subroutine check_real_const_shape_rank_3_optional_mask_present()
+    real :: a(3,4,5)
+    logical :: m(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape((/ real:: data60 /), shape(a))
+    m = reshape(mask60, shape(m))
+    calls_count = 0
+    call call_maxloc_real(r, a, m, get_scalar_false())
+    if (calls_count /= 1) error stop 155
+  end subroutine
+  subroutine check_real_const_shape_rank_3_optional_mask_absent()
+    real :: a(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape((/ real:: data60 /), shape(a))
+    calls_count = 0
+    call call_maxloc_real(r, a, b = get_scalar_false())
+    if (calls_count /= 1) error stop 165
+  end subroutine
+  subroutine check_real_const_shape_empty_4()
+    real :: a(9,3,0,7)
+    logical :: m(9,3,0,7)
+    integer, allocatable :: r(:,:,:)
+    a = reshape((/ real:: /), shape(a))
+    m = reshape((/ logical:: /), shape(m))
+    calls_count = 0
+    r = maxloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 172
+    r = maxloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 174
+    r = maxloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 176
+    r = maxloc(a, dim = 4, mask = m, back = get_scalar_false())
+    if (calls_count /= 4) error stop 178
+  end subroutine
+  subroutine check_real_alloc_rank_3()
+    real, allocatable :: a(:,:,:)
+    integer, allocatable :: r(:,:)
+    allocate(a(3,4,5))
+    a(:,:,:) = reshape((/ real:: data60 /), shape(a))
+    calls_count = 0
+    r = maxloc(a, dim = 1, back = get_scalar_false())
+    if (calls_count /= 1) error stop 182
+    r = maxloc(a, dim = 2, back = get_scalar_false())
+    if (calls_count /= 2) error stop 185
+    r = maxloc(a, dim = 3, back = get_scalar_false())
+    if (calls_count /= 3) error stop 188
+  end subroutine
+  subroutine check_real_alloc_rank_3_scalar_mask()
+    real, allocatable :: a(:,:,:)
+    integer, allocatable :: r(:,:)
+    allocate(a(3,4,5))
+    a(:,:,:) = reshape((/ real:: data60 /), shape(a))
+    calls_count = 0
+    ! We only check the case of a .true. mask.
+    ! If the mask is .false., the back argument is not necessary to deduce
+    ! the value returned by maxloc, so the compiler is free to elide it,
+    ! and the value of calls_count is undefined in that case.
+    r = maxloc(a, dim = 1, mask = .true., back = get_scalar_false())
+    if (calls_count /= 1) error stop 192
+    r = maxloc(a, dim = 2, mask = .true., back = get_scalar_false())
+    if (calls_count /= 2) error stop 195
+    r = maxloc(a, dim = 3, mask = .true., back = get_scalar_false())
+    if (calls_count /= 3) error stop 198
+  end subroutine
+  subroutine check_real_alloc_rank_3_array_mask()
+    real, allocatable :: a(:,:,:)
+    logical, allocatable :: m(:,:,:)
+    integer, allocatable :: r(:,:)
+    allocate(a(3,4,5), m(3,4,5))
+    a(:,:,:) = reshape((/ real:: data60 /), shape(a))
+    m(:,:,:) = reshape(mask60, shape(m))
+    calls_count = 0
+    r = maxloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 202
+    r = maxloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 205
+    r = maxloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 208
+  end subroutine
+  subroutine check_real_alloc_empty_4()
+    real, allocatable :: a(:,:,:,:)
+    logical, allocatable :: m(:,:,:,:)
+    integer, allocatable :: r(:,:,:)
+    allocate(a(9,3,0,7), m(9,3,0,7))
+    a(:,:,:,:) = reshape((/ real:: /), shape(a))
+    m(:,:,:,:) = reshape((/ logical :: /), shape(m))
+    calls_count = 0
+    r = maxloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 212
+    r = maxloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 214
+    r = maxloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 216
+    r = maxloc(a, dim = 4, mask = m, back = get_scalar_false())
+    if (calls_count /= 4) error stop 218
+  end subroutine
+end program p
diff --git a/gcc/testsuite/gfortran.dg/minloc_9.f90 b/gcc/testsuite/gfortran.dg/minloc_9.f90
new file mode 100644
index 00000000000..335b48a5909
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minloc_9.f90
@@ -0,0 +1,349 @@ 
+! { dg-do run }
+!
+! PR fortran/90608
+! Check that the evaluation of MINLOC's BACK argument is made only once
+! before the scalarization loops, when the DIM argument is present.
+
+program p
+  implicit none
+  integer, parameter :: data60(*) = (/ 7, 4, 5, 3, 9, 0, 6, 4, 5, 5,  &
+                                       8, 2, 6, 7, 8, 7, 4, 5, 3, 9,  &
+                                       0, 6, 4, 5, 5, 8, 2, 6, 7, 8,  &
+                                       7, 4, 5, 3, 9, 0, 6, 4, 5, 5,  &
+                                       8, 2, 6, 7, 8, 7, 4, 5, 3, 9,  &
+                                       0, 6, 4, 5, 5, 8, 2, 6, 7, 8  /)
+  logical, parameter :: mask60(*) = (/ .true. , .false., .false., .false., &
+                                       .true. , .false., .true. , .false., &
+                                       .false., .true. , .true. , .false., &
+                                       .true. , .true. , .true. , .true. , &
+                                       .false., .true. , .false., .true. , &
+                                       .false., .true. , .false., .true. , &
+                                       .true. , .false., .false., .true. , &
+                                       .true. , .true. , .true. , .false., &
+                                       .false., .false., .true. , .false., &
+                                       .true. , .false., .true. , .true. , &
+                                       .true. , .false., .true. , .true. , &
+                                       .false., .true. , .false., .true. , &
+                                       .false., .true. , .false., .false., &
+                                       .false., .true. , .true. , .true. , &
+                                       .false., .true. , .false., .true.  /)
+  integer :: calls_count = 0
+  call check_int_const_shape_rank_3
+  call check_int_const_shape_rank_3_scalar_mask
+  call check_int_const_shape_rank_3_optional_mask_present
+  call check_int_const_shape_rank_3_optional_mask_absent
+  call check_int_const_shape_rank_3_array_mask
+  call check_int_const_shape_empty_4
+  call check_int_alloc_rank_3
+  call check_int_alloc_rank_3_scalar_mask
+  call check_int_alloc_rank_3_array_mask
+  call check_int_alloc_empty_4
+  call check_real_const_shape_rank_3
+  call check_real_const_shape_rank_3_scalar_mask
+  call check_real_const_shape_rank_3_optional_mask_present
+  call check_real_const_shape_rank_3_optional_mask_absent
+  call check_real_const_shape_rank_3_array_mask
+  call check_real_const_shape_empty_4
+  call check_real_alloc_rank_3
+  call check_real_alloc_rank_3_scalar_mask
+  call check_real_alloc_rank_3_array_mask
+  call check_real_alloc_empty_4
+contains
+  function get_scalar_false()
+    logical :: get_scalar_false
+    calls_count = calls_count + 1
+    get_scalar_false = .false.
+  end function
+  subroutine check_int_const_shape_rank_3()
+    integer :: a(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape(data60, shape(a))
+    calls_count = 0
+    r = minloc(a, dim = 1, back = get_scalar_false())
+    if (calls_count /= 1) error stop 12
+    r = minloc(a, dim = 2, back = get_scalar_false())
+    if (calls_count /= 2) error stop 15
+    r = minloc(a, dim = 3, back = get_scalar_false())
+    if (calls_count /= 3) error stop 18
+  end subroutine
+  subroutine check_int_const_shape_rank_3_scalar_mask()
+    integer :: a(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape(data60, shape(a))
+    calls_count = 0
+    ! We only check the case of a .true. mask.
+    ! If the mask is .false., the back argument is not necessary to deduce
+    ! the value returned by minloc, so the compiler is free to elide it,
+    ! and the value of calls_count is undefined in that case.
+    r = minloc(a, dim = 1, mask = .true., back = get_scalar_false())
+    if (calls_count /= 1) error stop 22
+    r = minloc(a, dim = 2, mask = .true., back = get_scalar_false())
+    if (calls_count /= 2) error stop 25
+    r = minloc(a, dim = 3, mask = .true., back = get_scalar_false())
+    if (calls_count /= 3) error stop 28
+  end subroutine
+  subroutine call_minloc_int(r, a, m, b)
+    integer :: a(:,:,:)
+    logical, optional :: m(:,:,:)
+    logical, optional :: b
+    integer, allocatable :: r(:,:)
+    r = minloc(a, dim = 2, mask = m, back = b)
+  end subroutine
+  subroutine check_int_const_shape_rank_3_optional_mask_present()
+    integer :: a(3,4,5)
+    logical :: m(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape(data60, shape(a))
+    m = reshape(mask60, shape(m))
+    calls_count = 0
+    call call_minloc_int(r, a, m, get_scalar_false())
+    if (calls_count /= 1) error stop 45
+  end subroutine
+  subroutine check_int_const_shape_rank_3_optional_mask_absent()
+    integer :: a(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape(data60, shape(a))
+    calls_count = 0
+    call call_minloc_int(r, a, b = get_scalar_false())
+    if (calls_count /= 1) error stop 55
+  end subroutine
+  subroutine check_int_const_shape_rank_3_array_mask()
+    integer :: a(3,4,5)
+    logical :: m(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape(data60, shape(a))
+    m = reshape(mask60, shape(m))
+    calls_count = 0
+    r = minloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 62
+    r = minloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 65
+    r = minloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 68
+  end subroutine
+  subroutine check_int_const_shape_empty_4()
+    integer :: a(9,3,0,7)
+    logical :: m(9,3,0,7)
+    integer, allocatable :: r(:,:,:)
+    a = reshape((/ integer:: /), shape(a))
+    m = reshape((/ logical:: /), shape(m))
+    calls_count = 0
+    r = minloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 72
+    r = minloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 74
+    r = minloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 76
+    r = minloc(a, dim = 4, mask = m, back = get_scalar_false())
+    if (calls_count /= 4) error stop 78
+  end subroutine
+  subroutine check_int_alloc_rank_3()
+    integer, allocatable :: a(:,:,:)
+    integer, allocatable :: r(:,:)
+    allocate(a(3,4,5))
+    a(:,:,:) = reshape(data60, shape(a))
+    calls_count = 0
+    r = minloc(a, dim = 1, back = get_scalar_false())
+    if (calls_count /= 1) error stop 82
+    r = minloc(a, dim = 2, back = get_scalar_false())
+    if (calls_count /= 2) error stop 85
+    r = minloc(a, dim = 3, back = get_scalar_false())
+    if (calls_count /= 3) error stop 88
+  end subroutine
+  subroutine check_int_alloc_rank_3_scalar_mask()
+    integer, allocatable :: a(:,:,:)
+    integer, allocatable :: r(:,:)
+    allocate(a(3,4,5))
+    a(:,:,:) = reshape(data60, shape(a))
+    calls_count = 0
+    ! We only check the case of a .true. mask.
+    ! If the mask is .false., the back argument is not necessary to deduce
+    ! the value returned by minloc, so the compiler is free to elide it,
+    ! and the value of calls_count is undefined in that case.
+    r = minloc(a, dim = 1, mask = .true., back = get_scalar_false())
+    if (calls_count /= 1) error stop 92
+    r = minloc(a, dim = 2, mask = .true., back = get_scalar_false())
+    if (calls_count /= 2) error stop 95
+    r = minloc(a, dim = 3, mask = .true., back = get_scalar_false())
+    if (calls_count /= 3) error stop 98
+  end subroutine
+  subroutine check_int_alloc_rank_3_array_mask()
+    integer, allocatable :: a(:,:,:)
+    logical, allocatable :: m(:,:,:)
+    integer, allocatable :: r(:,:)
+    allocate(a(3,4,5), m(3,4,5))
+    a(:,:,:) = reshape(data60, shape(a))
+    m(:,:,:) = reshape(mask60, shape(m))
+    calls_count = 0
+    r = minloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 102
+    r = minloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 105
+    r = minloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 108
+  end subroutine
+  subroutine check_int_alloc_empty_4()
+    integer, allocatable :: a(:,:,:,:)
+    logical, allocatable :: m(:,:,:,:)
+    integer, allocatable :: r(:,:,:)
+    allocate(a(9,3,0,7), m(9,3,0,7))
+    a(:,:,:,:) = reshape((/ integer:: /), shape(a))
+    m(:,:,:,:) = reshape((/ logical:: /), shape(m))
+    calls_count = 0
+    r = minloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 112
+    r = minloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 114
+    r = minloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 116
+    r = minloc(a, dim = 4, mask = m, back = get_scalar_false())
+    if (calls_count /= 4) error stop 118
+  end subroutine
+  subroutine check_real_const_shape_rank_3()
+    real :: a(3,4,5)
+    logical :: m(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape((/ real:: data60 /), shape(a))
+    m = reshape(mask60, shape(m))
+    calls_count = 0
+    r = minloc(a, dim = 1, back = get_scalar_false())
+    if (calls_count /= 1) error stop 122
+    r = minloc(a, dim = 2, back = get_scalar_false())
+    if (calls_count /= 2) error stop 125
+    r = minloc(a, dim = 3, back = get_scalar_false())
+    if (calls_count /= 3) error stop 128
+  end subroutine
+  subroutine check_real_const_shape_rank_3_scalar_mask()
+    real :: a(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape((/ real:: data60 /), shape(a))
+    calls_count = 0
+    ! We only check the case of a .true. mask.
+    ! If the mask is .false., the back argument is not necessary to deduce
+    ! the value returned by minloc, so the compiler is free to elide it,
+    ! and the value of calls_count is undefined in that case.
+    r = minloc(a, dim = 1, mask = .true., back = get_scalar_false())
+    if (calls_count /= 1) error stop 132
+    r = minloc(a, dim = 2, mask = .true., back = get_scalar_false())
+    if (calls_count /= 2) error stop 135
+    r = minloc(a, dim = 3, mask = .true., back = get_scalar_false())
+    if (calls_count /= 3) error stop 138
+  end subroutine
+  subroutine check_real_const_shape_rank_3_array_mask()
+    real :: a(3,4,5)
+    logical :: m(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape((/ real:: data60 /), shape(a))
+    m = reshape(mask60, shape(m))
+    calls_count = 0
+    r = minloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 142
+    r = minloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 145
+    r = minloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 148
+  end subroutine
+  subroutine call_minloc_real(r, a, m, b)
+    real :: a(:,:,:)
+    logical, optional :: m(:,:,:)
+    logical, optional :: b
+    integer, allocatable :: r(:,:)
+    r = minloc(a, dim = 2, mask = m, back = b)
+  end subroutine
+  subroutine check_real_const_shape_rank_3_optional_mask_present()
+    real :: a(3,4,5)
+    logical :: m(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape((/ real:: data60 /), shape(a))
+    m = reshape(mask60, shape(m))
+    calls_count = 0
+    call call_minloc_real(r, a, m, get_scalar_false())
+    if (calls_count /= 1) error stop 155
+  end subroutine
+  subroutine check_real_const_shape_rank_3_optional_mask_absent()
+    real :: a(3,4,5)
+    integer, allocatable :: r(:,:)
+    a = reshape((/ real:: data60 /), shape(a))
+    calls_count = 0
+    call call_minloc_real(r, a, b = get_scalar_false())
+    if (calls_count /= 1) error stop 165
+  end subroutine
+  subroutine check_real_const_shape_empty_4()
+    real :: a(9,3,0,7)
+    logical :: m(9,3,0,7)
+    integer, allocatable :: r(:,:,:)
+    a = reshape((/ real:: /), shape(a))
+    m = reshape((/ logical:: /), shape(m))
+    calls_count = 0
+    r = minloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 172
+    r = minloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 174
+    r = minloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 176
+    r = minloc(a, dim = 4, mask = m, back = get_scalar_false())
+    if (calls_count /= 4) error stop 178
+  end subroutine
+  subroutine check_real_alloc_rank_3()
+    real, allocatable :: a(:,:,:)
+    integer, allocatable :: r(:,:)
+    allocate(a(3,4,5))
+    a(:,:,:) = reshape((/ real:: data60 /), shape(a))
+    calls_count = 0
+    r = minloc(a, dim = 1, back = get_scalar_false())
+    if (calls_count /= 1) error stop 182
+    r = minloc(a, dim = 2, back = get_scalar_false())
+    if (calls_count /= 2) error stop 185
+    r = minloc(a, dim = 3, back = get_scalar_false())
+    if (calls_count /= 3) error stop 188
+  end subroutine
+  subroutine check_real_alloc_rank_3_scalar_mask()
+    real, allocatable :: a(:,:,:)
+    integer, allocatable :: r(:,:)
+    allocate(a(3,4,5))
+    a(:,:,:) = reshape((/ real:: data60 /), shape(a))
+    calls_count = 0
+    ! We only check the case of a .true. mask.
+    ! If the mask is .false., the back argument is not necessary to deduce
+    ! the value returned by minloc, so the compiler is free to elide it,
+    ! and the value of calls_count is undefined in that case.
+    r = minloc(a, dim = 1, mask = .true., back = get_scalar_false())
+    if (calls_count /= 1) error stop 192
+    r = minloc(a, dim = 2, mask = .true., back = get_scalar_false())
+    if (calls_count /= 2) error stop 195
+    r = minloc(a, dim = 3, mask = .true., back = get_scalar_false())
+    if (calls_count /= 3) error stop 198
+  end subroutine
+  subroutine check_real_alloc_rank_3_array_mask()
+    real, allocatable :: a(:,:,:)
+    logical, allocatable :: m(:,:,:)
+    integer, allocatable :: r(:,:)
+    allocate(a(3,4,5), m(3,4,5))
+    a(:,:,:) = reshape((/ real:: data60 /), shape(a))
+    m(:,:,:) = reshape(mask60, shape(m))
+    calls_count = 0
+    r = minloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 202
+    r = minloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 205
+    r = minloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 208
+  end subroutine
+  subroutine check_real_alloc_empty_4()
+    real, allocatable :: a(:,:,:,:)
+    logical, allocatable :: m(:,:,:,:)
+    integer, allocatable :: r(:,:,:)
+    allocate(a(9,3,0,7), m(9,3,0,7))
+    a(:,:,:,:) = reshape((/ real:: /), shape(a))
+    m(:,:,:,:) = reshape((/ logical :: /), shape(m))
+    calls_count = 0
+    r = minloc(a, dim = 1, mask = m, back = get_scalar_false())
+    if (calls_count /= 1) error stop 212
+    r = minloc(a, dim = 2, mask = m, back = get_scalar_false())
+    if (calls_count /= 2) error stop 214
+    r = minloc(a, dim = 3, mask = m, back = get_scalar_false())
+    if (calls_count /= 3) error stop 216
+    r = minloc(a, dim = 4, mask = m, back = get_scalar_false())
+    if (calls_count /= 4) error stop 218
+  end subroutine
+end program p