--- /dev/null
+! { dg-do run }
+!
+! PR fortran/112371
+! The library used to not set the bounds and content of the resulting array
+! of a reduction function if the input array had zero extent along the
+! reduction dimension.
+
+program p
+ implicit none
+ call check_iall
+ call check_iany
+ call check_iparity
+ call check_minloc_int
+ call check_minloc_char
+ call check_maxloc_real
+ call check_maxloc_char
+ call check_minval_int
+ call check_minval_char
+ call check_maxval_real
+ call check_maxval_char
+ call check_sum
+ call check_product
+contains
+ subroutine check_iall
+ integer :: a(3,0,2)
+ logical(kind=1) :: m(3,0,2)
+ integer :: i
+ integer, allocatable :: r(:,:)
+ a = reshape((/ integer:: /), shape(a))
+ m = reshape((/ logical(kind=1):: /), shape(m))
+ i = 2
+ r = iall(a, dim=i, mask=m)
+ if (any(lbound(r) /= 1)) stop 11
+ if (any(ubound(r) /= (/ 3, 2 /))) stop 12
+ if (any(shape(r) /= (/ 3, 2 /))) stop 13
+ if (any(r /= int(z'FFFFFFFF'))) stop 14
+ end subroutine
+ subroutine check_iany
+ integer(kind=8) :: a(2,3,0)
+ logical(kind=1) :: m(2,3,0)
+ integer :: i
+ integer(kind=8), allocatable :: r(:,:)
+ a = reshape((/ integer(kind=8):: /), shape(a))
+ m = reshape((/ logical(kind=1):: /), shape(m))
+ i = 3
+ r = iany(a, dim=i, mask=m)
+ if (any(lbound(r) /= 1)) stop 21
+ if (any(ubound(r) /= (/ 2, 3 /))) stop 22
+ if (any(shape(r) /= (/ 2, 3 /))) stop 23
+ if (any(r /= 0)) stop 24
+ end subroutine
+ subroutine check_iparity
+ integer(kind=2) :: a(0,2,3)
+ logical(kind=1) :: m(0,2,3)
+ integer :: i
+ integer, allocatable :: r(:,:)
+ a = reshape((/ integer(kind=2):: /), shape(a))
+ m = reshape((/ logical(kind=1):: /), shape(m))
+ i = 1
+ r = iparity(a, dim=i, mask=m)
+ if (any(lbound(r) /= 1)) stop 31
+ if (any(ubound(r) /= (/ 2, 3 /))) stop 32
+ if (any(shape(r) /= (/ 2, 3 /))) stop 33
+ if (any(r /= 0)) stop 34
+ end subroutine
+ subroutine check_minloc_int
+ integer :: a(3,0,2)
+ logical(kind=1) :: m(3,0,2)
+ integer :: i, j
+ integer, allocatable :: r(:,:)
+ a = reshape((/ integer:: /), shape(a))
+ m = reshape((/ logical(kind=1):: /), shape(m))
+ i = 2
+ r = minloc(a, dim=i, mask=m)
+ if (any(lbound(r) /= 1)) stop 41
+ if (any(ubound(r) /= (/ 3, 2 /))) stop 42
+ if (any(shape(r) /= (/ 3, 2 /))) stop 43
+ if (any(r /= 0)) stop 44
+ end subroutine
+ subroutine check_minloc_char
+ character :: a(2,3,0)
+ logical(kind=1) :: m(2,3,0)
+ integer :: i
+ integer, allocatable :: r(:,:)
+ a = reshape((/ character:: /), shape(a))
+ m = reshape((/ logical(kind=1):: /), shape(m))
+ i = 3
+ r = minloc(a, dim=i, mask=m)
+ if (any(lbound(r) /= 1)) stop 51
+ if (any(ubound(r) /= (/ 2, 3 /))) stop 52
+ if (any(shape(r) /= (/ 2, 3 /))) stop 53
+ if (any(r /= 0)) stop 54
+ end subroutine
+ subroutine check_maxloc_real
+ real :: a(0,2,3)
+ logical(kind=1) :: m(0,2,3)
+ integer :: i
+ integer, allocatable :: r(:,:)
+ a = reshape((/ real:: /), shape(a))
+ m = reshape((/ logical(kind=1):: /), shape(m))
+ i = 1
+ r = maxloc(a, dim=i, mask=m)
+ if (any(lbound(r) /= 1)) stop 61
+ if (any(ubound(r) /= (/ 2, 3 /))) stop 62
+ if (any(shape(r) /= (/ 2, 3 /))) stop 63
+ if (any(r /= 0)) stop 64
+ end subroutine
+ subroutine check_maxloc_char
+ character(len=2) :: a(3,0,2)
+ logical(kind=1) :: m(3,0,2)
+ integer :: i
+ integer, allocatable :: r(:,:)
+ a = reshape((/ character(len=2):: /), shape(a))
+ m = reshape((/ logical(kind=1):: /), shape(m))
+ i = 2
+ r = maxloc(a, dim=i, mask=m)
+ if (any(lbound(r) /= 1)) stop 71
+ if (any(ubound(r) /= (/ 3, 2 /))) stop 72
+ if (any(shape(r) /= (/ 3, 2 /))) stop 73
+ if (any(r /= 0)) stop 74
+ end subroutine
+ subroutine check_minval_int
+ integer(kind=2) :: a(3,2,0)
+ logical(kind=1) :: m(3,2,0)
+ integer :: i, j
+ integer, allocatable :: r(:,:)
+ a = reshape((/ integer(kind=2):: /), shape(a))
+ m = reshape((/ logical(kind=1):: /), shape(m))
+ i = 3
+ r = minval(a, dim=i, mask=m)
+ if (any(lbound(r) /= 1)) stop 81
+ if (any(ubound(r) /= (/ 3, 2 /))) stop 82
+ if (any(shape(r) /= (/ 3, 2 /))) stop 83
+ if (any(r /= huge(1_2))) stop 84
+ end subroutine
+ subroutine check_minval_char
+ character(kind=4) :: a(0,3,2)
+ logical(kind=1) :: m(0,3,2)
+ integer :: i
+ character(kind=4), allocatable :: r(:,:)
+ a = reshape((/ character(kind=4):: /), shape(a))
+ m = reshape((/ logical(kind=1):: /), shape(m))
+ i = 1
+ r = minval(a, dim=i, mask=m)
+ if (any(lbound(r) /= 1)) stop 91
+ if (any(ubound(r) /= (/ 3, 2 /))) stop 92
+ if (any(shape(r) /= (/ 3, 2 /))) stop 93
+ if (any(r /= char(int(z'FFFFFFFF', kind=8), kind=4))) stop 94
+ end subroutine
+ subroutine check_maxval_real
+ real(kind=8) :: a(0,2,3)
+ logical(kind=1) :: m(0,2,3)
+ integer :: i
+ real(kind=8), allocatable :: r(:,:)
+ a = reshape((/ real(kind=8):: /), shape(a))
+ m = reshape((/ logical(kind=1):: /), shape(m))
+ i = 1
+ r = maxval(a, dim=i, mask=m)
+ if (any(lbound(r) /= 1)) stop 101
+ if (any(ubound(r) /= (/ 2, 3 /))) stop 102
+ if (any(shape(r) /= (/ 2, 3 /))) stop 103
+ if (any(r /= -huge(1._8))) stop 104
+ end subroutine
+ subroutine check_maxval_char
+ character(kind=4,len=2) :: a(3,0,2), e
+ logical(kind=1) :: m(3,0,2)
+ integer :: i
+ character(len=2,kind=4), allocatable :: r(:,:)
+ a = reshape((/ character(kind=4,len=2):: /), shape(a))
+ m = reshape((/ logical(kind=1):: /), shape(m))
+ i = 2
+ r = maxval(a, dim=i, mask=m)
+ if (any(lbound(r) /= 1)) stop 111
+ if (any(ubound(r) /= (/ 3, 2 /))) stop 112
+ if (any(shape(r) /= (/ 3, 2 /))) stop 113
+ e = repeat(char(0, kind=4), len(a))
+ if (any(r /= e)) stop 114
+ end subroutine
+ subroutine check_sum
+ integer(kind=1) :: a(2,3,0)
+ logical(kind=1) :: m(2,3,0)
+ integer :: i
+ integer, allocatable :: r(:,:)
+ a = reshape((/ integer:: /), shape(a))
+ m = reshape((/ logical(kind=1):: /), shape(m))
+ i = 3
+ r = sum(a, dim=i, mask=m)
+ if (any(lbound(r) /= 1)) stop 121
+ if (any(ubound(r) /= (/ 2, 3 /))) stop 122
+ if (any(shape(r) /= (/ 2, 3 /))) stop 123
+ if (any(r /= 0)) stop 124
+ end subroutine
+ subroutine check_product
+ real(kind=8) :: a(0,2,3)
+ logical(kind=1) :: m(0,2,3)
+ integer :: i
+ integer, allocatable :: r(:,:)
+ a = reshape((/ real(kind=8):: /), shape(a))
+ m = reshape((/ logical(kind=1):: /), shape(m))
+ i = 1
+ r = product(a, dim=i, mask=m)
+ if (any(lbound(r) /= 1)) stop 131
+ if (any(ubound(r) /= (/ 2, 3 /))) stop 132
+ if (any(shape(r) /= (/ 2, 3 /))) stop 133
+ if (any(r /= 1.0_8)) stop 134
+ end subroutine
+end program
projects / thirdparty / gcc.git / commitdiff
