libgfortran: Remove empty array descriptor first dimension overwrite [PR112371]

Remove the forced overwrite of the first dimension of the result array
descriptor to set it to zero extent, in the function templates for
transformational functions doing an array reduction along a dimension.  This
overwrite, which happened before early returning in case the result array
was empty, was wrong because an array may have a non-zero extent in the
first dimension and still be empty if it has a zero extent in a higher
dimension.  Overwriting the dimension was resulting in wrong array result
upper bound for the first dimension in that case.

The offending piece of code was present in several places, and this removes
them all.  More precisely, there is only one case to fix for logical
reduction functions, and there are three cases for other reduction
functions, corresponding to non-masked reduction, reduction with array mask,
and reduction with scalar mask.  The impacted m4 files are
ifunction_logical.m4 for logical reduction functions, ifunction.m4 for
regular functions and types, ifunction-s.m4 for character minloc and maxloc,
ifunction-s2.m4 for character minval and maxval, and ifindloc1.m4 for
findloc.

	PR fortran/112371

libgfortran/ChangeLog:

	* m4/ifunction.m4 (START_ARRAY_FUNCTION, START_MASKED_ARRAY_FUNCTION,
	SCALAR_ARRAY_FUNCTION): Remove overwrite of the first dimension of the
	array descriptor.
	* m4/ifunction-s.m4 (START_ARRAY_FUNCTION, START_MASKED_ARRAY_FUNCTION,
	SCALAR_ARRAY_FUNCTION): Ditto.
	* m4/ifunction-s2.m4 (START_ARRAY_FUNCTION,
	START_MASKED_ARRAY_FUNCTION, SCALAR_ARRAY_FUNCTION): Ditto.
	* m4/ifunction_logical.m4 (START_ARRAY_FUNCTION): Ditto.
	* m4/ifindloc1.m4: Ditto.
	* generated/all_l1.c: Regenerate.
	* generated/all_l16.c: Regenerate.
	* generated/all_l2.c: Regenerate.
	* generated/all_l4.c: Regenerate.
	* generated/all_l8.c: Regenerate.
	* generated/any_l1.c: Regenerate.
	* generated/any_l16.c: Regenerate.
	* generated/any_l2.c: Regenerate.
	* generated/any_l4.c: Regenerate.
	* generated/any_l8.c: Regenerate.
	* generated/count_16_l.c: Regenerate.
	* generated/count_1_l.c: Regenerate.
	* generated/count_2_l.c: Regenerate.
	* generated/count_4_l.c: Regenerate.
	* generated/count_8_l.c: Regenerate.
	* generated/findloc1_c10.c: Regenerate.
	* generated/findloc1_c16.c: Regenerate.
	* generated/findloc1_c17.c: Regenerate.
	* generated/findloc1_c4.c: Regenerate.
	* generated/findloc1_c8.c: Regenerate.
	* generated/findloc1_i1.c: Regenerate.
	* generated/findloc1_i16.c: Regenerate.
	* generated/findloc1_i2.c: Regenerate.
	* generated/findloc1_i4.c: Regenerate.
	* generated/findloc1_i8.c: Regenerate.
	* generated/findloc1_r10.c: Regenerate.
	* generated/findloc1_r16.c: Regenerate.
	* generated/findloc1_r17.c: Regenerate.
	* generated/findloc1_r4.c: Regenerate.
	* generated/findloc1_r8.c: Regenerate.
	* generated/findloc1_s1.c: Regenerate.
	* generated/findloc1_s4.c: Regenerate.
	* generated/iall_i1.c: Regenerate.
	* generated/iall_i16.c: Regenerate.
	* generated/iall_i2.c: Regenerate.
	* generated/iall_i4.c: Regenerate.
	* generated/iall_i8.c: Regenerate.
	* generated/iany_i1.c: Regenerate.
	* generated/iany_i16.c: Regenerate.
	* generated/iany_i2.c: Regenerate.
	* generated/iany_i4.c: Regenerate.
	* generated/iany_i8.c: Regenerate.
	* generated/iparity_i1.c: Regenerate.
	* generated/iparity_i16.c: Regenerate.
	* generated/iparity_i2.c: Regenerate.
	* generated/iparity_i4.c: Regenerate.
	* generated/iparity_i8.c: Regenerate.
	* generated/maxloc1_16_i1.c: Regenerate.
	* generated/maxloc1_16_i16.c: Regenerate.
	* generated/maxloc1_16_i2.c: Regenerate.
	* generated/maxloc1_16_i4.c: Regenerate.
	* generated/maxloc1_16_i8.c: Regenerate.
	* generated/maxloc1_16_r10.c: Regenerate.
	* generated/maxloc1_16_r16.c: Regenerate.
	* generated/maxloc1_16_r17.c: Regenerate.
	* generated/maxloc1_16_r4.c: Regenerate.
	* generated/maxloc1_16_r8.c: Regenerate.
	* generated/maxloc1_16_s1.c: Regenerate.
	* generated/maxloc1_16_s4.c: Regenerate.
	* generated/maxloc1_4_i1.c: Regenerate.
	* generated/maxloc1_4_i16.c: Regenerate.
	* generated/maxloc1_4_i2.c: Regenerate.
	* generated/maxloc1_4_i4.c: Regenerate.
	* generated/maxloc1_4_i8.c: Regenerate.
	* generated/maxloc1_4_r10.c: Regenerate.
	* generated/maxloc1_4_r16.c: Regenerate.
	* generated/maxloc1_4_r17.c: Regenerate.
	* generated/maxloc1_4_r4.c: Regenerate.
	* generated/maxloc1_4_r8.c: Regenerate.
	* generated/maxloc1_4_s1.c: Regenerate.
	* generated/maxloc1_4_s4.c: Regenerate.
	* generated/maxloc1_8_i1.c: Regenerate.
	* generated/maxloc1_8_i16.c: Regenerate.
	* generated/maxloc1_8_i2.c: Regenerate.
	* generated/maxloc1_8_i4.c: Regenerate.
	* generated/maxloc1_8_i8.c: Regenerate.
	* generated/maxloc1_8_r10.c: Regenerate.
	* generated/maxloc1_8_r16.c: Regenerate.
	* generated/maxloc1_8_r17.c: Regenerate.
	* generated/maxloc1_8_r4.c: Regenerate.
	* generated/maxloc1_8_r8.c: Regenerate.
	* generated/maxloc1_8_s1.c: Regenerate.
	* generated/maxloc1_8_s4.c: Regenerate.
	* generated/maxval1_s1.c: Regenerate.
	* generated/maxval1_s4.c: Regenerate.
	* generated/maxval_i1.c: Regenerate.
	* generated/maxval_i16.c: Regenerate.
	* generated/maxval_i2.c: Regenerate.
	* generated/maxval_i4.c: Regenerate.
	* generated/maxval_i8.c: Regenerate.
	* generated/maxval_r10.c: Regenerate.
	* generated/maxval_r16.c: Regenerate.
	* generated/maxval_r17.c: Regenerate.
	* generated/maxval_r4.c: Regenerate.
	* generated/maxval_r8.c: Regenerate.
	* generated/minloc1_16_i1.c: Regenerate.
	* generated/minloc1_16_i16.c: Regenerate.
	* generated/minloc1_16_i2.c: Regenerate.
	* generated/minloc1_16_i4.c: Regenerate.
	* generated/minloc1_16_i8.c: Regenerate.
	* generated/minloc1_16_r10.c: Regenerate.
	* generated/minloc1_16_r16.c: Regenerate.
	* generated/minloc1_16_r17.c: Regenerate.
	* generated/minloc1_16_r4.c: Regenerate.
	* generated/minloc1_16_r8.c: Regenerate.
	* generated/minloc1_16_s1.c: Regenerate.
	* generated/minloc1_16_s4.c: Regenerate.
	* generated/minloc1_4_i1.c: Regenerate.
	* generated/minloc1_4_i16.c: Regenerate.
	* generated/minloc1_4_i2.c: Regenerate.
	* generated/minloc1_4_i4.c: Regenerate.
	* generated/minloc1_4_i8.c: Regenerate.
	* generated/minloc1_4_r10.c: Regenerate.
	* generated/minloc1_4_r16.c: Regenerate.
	* generated/minloc1_4_r17.c: Regenerate.
	* generated/minloc1_4_r4.c: Regenerate.
	* generated/minloc1_4_r8.c: Regenerate.
	* generated/minloc1_4_s1.c: Regenerate.
	* generated/minloc1_4_s4.c: Regenerate.
	* generated/minloc1_8_i1.c: Regenerate.
	* generated/minloc1_8_i16.c: Regenerate.
	* generated/minloc1_8_i2.c: Regenerate.
	* generated/minloc1_8_i4.c: Regenerate.
	* generated/minloc1_8_i8.c: Regenerate.
	* generated/minloc1_8_r10.c: Regenerate.
	* generated/minloc1_8_r16.c: Regenerate.
	* generated/minloc1_8_r17.c: Regenerate.
	* generated/minloc1_8_r4.c: Regenerate.
	* generated/minloc1_8_r8.c: Regenerate.
	* generated/minloc1_8_s1.c: Regenerate.
	* generated/minloc1_8_s4.c: Regenerate.
	* generated/minval1_s1.c: Regenerate.
	* generated/minval1_s4.c: Regenerate.
	* generated/minval_i1.c: Regenerate.
	* generated/minval_i16.c: Regenerate.
	* generated/minval_i2.c: Regenerate.
	* generated/minval_i4.c: Regenerate.
	* generated/minval_i8.c: Regenerate.
	* generated/minval_r10.c: Regenerate.
	* generated/minval_r16.c: Regenerate.
	* generated/minval_r17.c: Regenerate.
	* generated/minval_r4.c: Regenerate.
	* generated/minval_r8.c: Regenerate.
	* generated/norm2_r10.c: Regenerate.
	* generated/norm2_r16.c: Regenerate.
	* generated/norm2_r17.c: Regenerate.
	* generated/norm2_r4.c: Regenerate.
	* generated/norm2_r8.c: Regenerate.
	* generated/parity_l1.c: Regenerate.
	* generated/parity_l16.c: Regenerate.
	* generated/parity_l2.c: Regenerate.
	* generated/parity_l4.c: Regenerate.
	* generated/parity_l8.c: Regenerate.
	* generated/product_c10.c: Regenerate.
	* generated/product_c16.c: Regenerate.
	* generated/product_c17.c: Regenerate.
	* generated/product_c4.c: Regenerate.
	* generated/product_c8.c: Regenerate.
	* generated/product_i1.c: Regenerate.
	* generated/product_i16.c: Regenerate.
	* generated/product_i2.c: Regenerate.
	* generated/product_i4.c: Regenerate.
	* generated/product_i8.c: Regenerate.
	* generated/product_r10.c: Regenerate.
	* generated/product_r16.c: Regenerate.
	* generated/product_r17.c: Regenerate.
	* generated/product_r4.c: Regenerate.
	* generated/product_r8.c: Regenerate.
	* generated/sum_c10.c: Regenerate.
	* generated/sum_c16.c: Regenerate.
	* generated/sum_c17.c: Regenerate.
	* generated/sum_c4.c: Regenerate.
	* generated/sum_c8.c: Regenerate.
	* generated/sum_i1.c: Regenerate.
	* generated/sum_i16.c: Regenerate.
	* generated/sum_i2.c: Regenerate.
	* generated/sum_i4.c: Regenerate.
	* generated/sum_i8.c: Regenerate.
	* generated/sum_r10.c: Regenerate.
	* generated/sum_r16.c: Regenerate.
	* generated/sum_r17.c: Regenerate.
	* generated/sum_r4.c: Regenerate.
	* generated/sum_r8.c: Regenerate.

gcc/testsuite/ChangeLog:

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

1 files changed, 588 insertions, 0 deletions

diff --git a/gcc/testsuite/gfortran.dg/bound_11.f90 b/gcc/testsuite/gfortran.dg/bound_11.f90
new file mode 100644
index 0000000..170eba4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_11.f90
@@ -0,0 +1,588 @@
+! { dg-do run }
+!
+! PR fortran/112371
+! The library used to incorrectly set an extent of zero for the first
+! dimension of the resulting array of a reduction function if that array was
+! empty.
+
+program p
+  implicit none
+  call check_iparity
+  call check_sum
+  call check_minloc_int
+  call check_minloc_char
+  call check_maxloc_char4
+  call check_minval_char
+  call check_maxval_char4
+  call check_any
+  call check_count4
+  call check_findloc_int
+  call check_findloc_char
+contains
+  subroutine check_iparity
+    integer :: a(9,3,0,7)
+    logical :: m1(9,3,0,7)
+    logical(kind=4) :: m4
+    integer :: i
+    integer, allocatable :: r(:,:,:)
+    a  = reshape((/ integer:: /), shape(a))
+    m1 = reshape((/ logical:: /), shape(m1))
+    m4 = .false.
+    i = 1
+    r = iparity(a, dim=i)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 111
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 112
+    i = 2
+    r = iparity(a, dim=i)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 113
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 114
+    i = 3
+    r = iparity(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 115
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 116
+    i = 4
+    r = iparity(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 117
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 118
+    i = 1
+    r = iparity(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 121
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 122
+    i = 2
+    r = iparity(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 123
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 124
+    i = 3
+    r = iparity(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 125
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 126
+    i = 4
+    r = iparity(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 127
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 128
+    i = 1
+    r = iparity(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 131
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 132
+    i = 2
+    r = iparity(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 133
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 134
+    i = 3
+    r = iparity(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 135
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 136
+    i = 4
+    r = iparity(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 137
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 138
+  end subroutine
+  subroutine check_sum
+    integer :: a(9,3,0,7)
+    logical :: m1(9,3,0,7)
+    logical(kind=4) :: m4
+    integer :: i
+    integer, allocatable :: r(:,:,:)
+    a  = reshape((/ integer:: /), shape(a))
+    m1 = reshape((/ logical:: /), shape(m1))
+    m4 = .false.
+    i = 1
+    r = sum(a, dim=i)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 211
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 212
+    i = 2
+    r = sum(a, dim=i)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 213
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 214
+    i = 3
+    r = sum(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 215
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 216
+    i = 4
+    r = sum(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 217
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 218
+    i = 1
+    r = sum(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 221
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 222
+    i = 2
+    r = sum(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 223
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 224
+    i = 3
+    r = sum(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 225
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 226
+    i = 4
+    r = sum(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 227
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 228
+    i = 1
+    r = sum(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 231
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 232
+    i = 2
+    r = sum(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 233
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 234
+    i = 3
+    r = sum(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 235
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 236
+    i = 4
+    r = sum(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 237
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 238
+  end subroutine
+  subroutine check_minloc_int
+    integer :: a(9,3,0,7)
+    logical :: m1(9,3,0,7)
+    logical(kind=4) :: m4
+    integer :: i
+    integer, allocatable :: r(:,:,:)
+    a  = reshape((/ integer:: /), shape(a))
+    m1 = reshape((/ logical:: /), shape(m1))
+    m4 = .false.
+    i = 1
+    r = minloc(a, dim=i)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 311
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 312
+    i = 2
+    r = minloc(a, dim=i)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 313
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 314
+    i = 3
+    r = minloc(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 315
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 316
+    i = 4
+    r = minloc(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 317
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 318
+    i = 1
+    r = minloc(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 321
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 322
+    i = 2
+    r = minloc(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 323
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 324
+    i = 3
+    r = minloc(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 325
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 326
+    i = 4
+    r = minloc(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 327
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 328
+    i = 1
+    r = minloc(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 331
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 332
+    i = 2
+    r = minloc(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 333
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 334
+    i = 3
+    r = minloc(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 335
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 336
+    i = 4
+    r = minloc(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 337
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 338
+  end subroutine
+  subroutine check_minloc_char
+    character :: a(9,3,0,7)
+    logical :: m1(9,3,0,7)
+    logical(kind=4) :: m4
+    integer :: i
+    integer, allocatable :: r(:,:,:)
+    a  = reshape((/ character:: /), shape(a))
+    m1 = reshape((/ logical:: /), shape(m1))
+    m4 = .false.
+    i = 1
+    r = minloc(a, dim=i)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 411
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 412
+    i = 2
+    r = minloc(a, dim=i)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 413
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 414
+    i = 3
+    r = minloc(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 415
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 416
+    i = 4
+    r = minloc(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 417
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 418
+    i = 1
+    r = minloc(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 421
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 422
+    i = 2
+    r = minloc(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 423
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 424
+    i = 3
+    r = minloc(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 425
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 426
+    i = 4
+    r = minloc(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 427
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 428
+    i = 1
+    r = minloc(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 431
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 432
+    i = 2
+    r = minloc(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 433
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 434
+    i = 3
+    r = minloc(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 435
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 436
+    i = 4
+    r = minloc(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 437
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 438
+  end subroutine
+  subroutine check_maxloc_char4
+    character(kind=4) :: a(9,3,0,7)
+    logical :: m1(9,3,0,7)
+    logical(kind=4) :: m4
+    integer :: i
+    integer, allocatable :: r(:,:,:)
+    a  = reshape((/ character(kind=4):: /), shape(a))
+    m1 = reshape((/ logical:: /), shape(m1))
+    m4 = .false.
+    i = 1
+    r = maxloc(a, dim=i)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 511
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 512
+    i = 2
+    r = maxloc(a, dim=i)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 513
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 514
+    i = 3
+    r = maxloc(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 515
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 516
+    i = 4
+    r = maxloc(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 517
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 518
+    i = 1
+    r = maxloc(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 521
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 522
+    i = 2
+    r = maxloc(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 523
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 524
+    i = 3
+    r = maxloc(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 525
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 526
+    i = 4
+    r = maxloc(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 527
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 528
+    i = 1
+    r = maxloc(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 531
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 532
+    i = 2
+    r = maxloc(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 533
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 534
+    i = 3
+    r = maxloc(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 535
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 536
+    i = 4
+    r = maxloc(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 537
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 538
+  end subroutine
+  subroutine check_minval_char
+    character :: a(9,3,0,7)
+    logical :: m1(9,3,0,7)
+    logical(kind=4) :: m4
+    integer :: i
+    character, allocatable :: r(:,:,:)
+    a  = reshape((/ character:: /), shape(a))
+    m1 = reshape((/ logical:: /), shape(m1))
+    m4 = .false.
+    i = 1
+    r = minval(a, dim=i)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 611
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 612
+    i = 2
+    r = minval(a, dim=i)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 613
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 614
+    i = 3
+    r = minval(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 615
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 616
+    i = 4
+    r = minval(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 617
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 618
+    i = 1
+    r = minval(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 621
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 622
+    i = 2
+    r = minval(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 623
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 624
+    i = 3
+    r = minval(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 625
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 626
+    i = 4
+    r = minval(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 627
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 628
+    i = 1
+    r = minval(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 631
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 632
+    i = 2
+    r = minval(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 633
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 634
+    i = 3
+    r = minval(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 635
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 636
+    i = 4
+    r = minval(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 637
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 638
+  end subroutine
+  subroutine check_maxval_char4
+    character(kind=4) :: a(9,3,0,7)
+    logical :: m1(9,3,0,7)
+    logical(kind=4) :: m4
+    integer :: i
+    character(kind=4), allocatable :: r(:,:,:)
+    a  = reshape((/ character(kind=4):: /), shape(a))
+    m1 = reshape((/ logical:: /), shape(m1))
+    m4 = .false.
+    i = 1
+    r = maxval(a, dim=i)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 711
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 712
+    i = 2
+    r = maxval(a, dim=i)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 713
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 714
+    i = 3
+    r = maxval(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 715
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 716
+    i = 4
+    r = maxval(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 717
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 718
+    i = 1
+    r = maxval(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 721
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 722
+    i = 2
+    r = maxval(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 723
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 724
+    i = 3
+    r = maxval(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 725
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 726
+    i = 4
+    r = maxval(a, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 727
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 728
+    i = 1
+    r = maxval(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 731
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 732
+    i = 2
+    r = maxval(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 733
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 734
+    i = 3
+    r = maxval(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 735
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 736
+    i = 4
+    r = maxval(a, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 737
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 738
+  end subroutine
+  subroutine check_any
+    logical :: a(9,3,0,7)
+    integer :: i
+    logical, allocatable :: r(:,:,:)
+    a  = reshape((/ logical:: /), shape(a))
+    i = 1
+    r = any(a, dim=i)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 811
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 812
+    i = 2
+    r = any(a, dim=i)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 813
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 814
+    i = 3
+    r = any(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 815
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 816
+    i = 4
+    r = any(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 817
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 818
+  end subroutine
+  subroutine check_count4
+    logical(kind=4) :: a(9,3,0,7)
+    integer :: i
+    integer, allocatable :: r(:,:,:)
+    a  = reshape((/ logical(kind=4):: /), shape(a))
+    i = 1
+    r = count(a, dim=i)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 911
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 912
+    i = 2
+    r = count(a, dim=i)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 913
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 914
+    i = 3
+    r = count(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 915
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 916
+    i = 4
+    r = count(a, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 917
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 918
+  end subroutine
+  subroutine check_findloc_int
+    integer :: a(9,3,0,7)
+    logical :: m1(9,3,0,7)
+    logical(kind=4) :: m4
+    integer :: i
+    integer, allocatable :: r(:,:,:)
+    a  = reshape((/ integer:: /), shape(a))
+    m1 = reshape((/ logical:: /), shape(m1))
+    m4 = .false.
+    i = 1
+    r = findloc(a, 10, dim=i)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 1011
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 1012
+    i = 2
+    r = findloc(a, 10, dim=i)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 1013
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 1014
+    i = 3
+    r = findloc(a, 10, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 1015
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 1016
+    i = 4
+    r = findloc(a, 10, dim=i)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 1017
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 1018
+    i = 1
+    r = findloc(a, 10, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 1021
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 1022
+    i = 2
+    r = findloc(a, 10, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 1023
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 1024
+    i = 3
+    r = findloc(a, 10, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 1025
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 1026
+    i = 4
+    r = findloc(a, 10, dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 1027
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 1028
+    i = 1
+    r = findloc(a, 10, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 1031
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 1032
+    i = 2
+    r = findloc(a, 10, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 1033
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 1034
+    i = 3
+    r = findloc(a, 10, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 1035
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 1036
+    i = 4
+    r = findloc(a, 10, dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 1037
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 1038
+  end subroutine
+  subroutine check_findloc_char
+    character :: a(9,3,0,7)
+    logical :: m1(9,3,0,7)
+    logical(kind=4) :: m4
+    integer :: i
+    integer, allocatable :: r(:,:,:)
+    a  = reshape((/ character:: /), shape(a))
+    m1 = reshape((/ logical:: /), shape(m1))
+    m4 = .false.
+    i = 1
+    r = findloc(a, "a", dim=i)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 1111
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 1112
+    i = 2
+    r = findloc(a, "a", dim=i)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 1113
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 1114
+    i = 3
+    r = findloc(a, "a", dim=i)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 1115
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 1116
+    i = 4
+    r = findloc(a, "a", dim=i)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 1117
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 1118
+    i = 1
+    r = findloc(a, "a", dim=i, mask=m1)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 1121
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 1122
+    i = 2
+    r = findloc(a, "a", dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 1123
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 1124
+    i = 3
+    r = findloc(a, "a", dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 1125
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 1126
+    i = 4
+    r = findloc(a, "a", dim=i, mask=m1)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 1127
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 1128
+    i = 1
+    r = findloc(a, "a", dim=i, mask=m4)
+    if (any(shape(r) /= (/ 3, 0, 7 /))) stop 1131
+    if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 1132
+    i = 2
+    r = findloc(a, "a", dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 0, 7 /))) stop 1133
+    if (any(ubound(r) /= (/ 9, 0, 7 /))) stop 1134
+    i = 3
+    r = findloc(a, "a", dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 7 /))) stop 1135
+    if (any(ubound(r) /= (/ 9, 3, 7 /))) stop 1136
+    i = 4
+    r = findloc(a, "a", dim=i, mask=m4)
+    if (any(shape(r) /= (/ 9, 3, 0 /))) stop 1137
+    if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 1138
+  end subroutine
+end program