gcc/testsuite/gfortran.dg/bound_10.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/112371
   4 ! The library used to not set the bounds and content of the resulting array
   5 ! of a reduction function if the input array had zero extent along the
   6 ! reduction dimension.
   7
   8 program p
   9   implicit none
  10   call check_iall
  11   call check_iany
  12   call check_iparity
  13   call check_minloc_int
  14   call check_minloc_char
  15   call check_maxloc_real
  16   call check_maxloc_char
  17   call check_minval_int
  18   call check_minval_char
  19   call check_maxval_real
  20   call check_maxval_char
  21   call check_sum
  22   call check_product
  23 contains
  24   subroutine check_iall
  25     integer :: a(3,0,2)
  26     logical(kind=1) :: m(3,0,2)
  27     integer :: i
  28     integer, allocatable :: r(:,:)
  29     a = reshape((/ integer:: /), shape(a))
  30     m = reshape((/ logical(kind=1):: /), shape(m))
  31     i = 2
  32     r = iall(a, dim=i, mask=m)
  33     if (any(lbound(r) /= 1)) stop 11
  34     if (any(ubound(r) /= (/ 3, 2 /))) stop 12
  35     if (any(shape(r) /= (/ 3, 2 /))) stop 13
  36     if (any(r /= int(z'FFFFFFFF'))) stop 14
  37   end subroutine
  38   subroutine check_iany
  39     integer(kind=8) :: a(2,3,0)
  40     logical(kind=1) :: m(2,3,0)
  41     integer :: i
  42     integer(kind=8), allocatable :: r(:,:)
  43     a = reshape((/ integer(kind=8):: /), shape(a))
  44     m = reshape((/ logical(kind=1):: /), shape(m))
  45     i = 3
  46     r = iany(a, dim=i, mask=m)
  47     if (any(lbound(r) /= 1)) stop 21
  48     if (any(ubound(r) /= (/ 2, 3 /))) stop 22
  49     if (any(shape(r) /= (/ 2, 3 /))) stop 23
  50     if (any(r /= 0)) stop 24
  51   end subroutine
  52   subroutine check_iparity
  53     integer(kind=2) :: a(0,2,3)
  54     logical(kind=1) :: m(0,2,3)
  55     integer :: i
  56     integer, allocatable :: r(:,:)
  57     a = reshape((/ integer(kind=2):: /), shape(a))
  58     m = reshape((/ logical(kind=1):: /), shape(m))
  59     i = 1
  60     r = iparity(a, dim=i, mask=m)
  61     if (any(lbound(r) /= 1)) stop 31
  62     if (any(ubound(r) /= (/ 2, 3 /))) stop 32
  63     if (any(shape(r) /= (/ 2, 3 /))) stop 33
  64     if (any(r /= 0)) stop 34
  65   end subroutine
  66   subroutine check_minloc_int
  67     integer :: a(3,0,2)
  68     logical(kind=1) :: m(3,0,2)
  69     integer :: i, j
  70     integer, allocatable :: r(:,:)
  71     a = reshape((/ integer:: /), shape(a))
  72     m = reshape((/ logical(kind=1):: /), shape(m))
  73     i = 2
  74     r = minloc(a, dim=i, mask=m)
  75     if (any(lbound(r) /= 1)) stop 41
  76     if (any(ubound(r) /= (/ 3, 2 /))) stop 42
  77     if (any(shape(r) /= (/ 3, 2 /))) stop 43
  78     if (any(r /= 0)) stop 44
  79   end subroutine
  80   subroutine check_minloc_char
  81     character :: a(2,3,0)
  82     logical(kind=1) :: m(2,3,0)
  83     integer :: i
  84     integer, allocatable :: r(:,:)
  85     a = reshape((/ character:: /), shape(a))
  86     m = reshape((/ logical(kind=1):: /), shape(m))
  87     i = 3
  88     r = minloc(a, dim=i, mask=m)
  89     if (any(lbound(r) /= 1)) stop 51
  90     if (any(ubound(r) /= (/ 2, 3 /))) stop 52
  91     if (any(shape(r) /= (/ 2, 3 /))) stop 53
  92     if (any(r /= 0)) stop 54
  93   end subroutine
  94   subroutine check_maxloc_real
  95     real :: a(0,2,3)
  96     logical(kind=1) :: m(0,2,3)
  97     integer :: i
  98     integer, allocatable :: r(:,:)
  99     a = reshape((/ real:: /), shape(a))
 100     m = reshape((/ logical(kind=1):: /), shape(m))
 101     i = 1
 102     r = maxloc(a, dim=i, mask=m)
 103     if (any(lbound(r) /= 1)) stop 61
 104     if (any(ubound(r) /= (/ 2, 3 /))) stop 62
 105     if (any(shape(r) /= (/ 2, 3 /))) stop 63
 106     if (any(r /= 0)) stop 64
 107   end subroutine
 108   subroutine check_maxloc_char
 109     character(len=2) :: a(3,0,2)
 110     logical(kind=1) :: m(3,0,2)
 111     integer :: i
 112     integer, allocatable :: r(:,:)
 113     a = reshape((/ character(len=2):: /), shape(a))
 114     m = reshape((/ logical(kind=1):: /), shape(m))
 115     i = 2
 116     r = maxloc(a, dim=i, mask=m)
 117     if (any(lbound(r) /= 1)) stop 71
 118     if (any(ubound(r) /= (/ 3, 2 /))) stop 72
 119     if (any(shape(r) /= (/ 3, 2 /))) stop 73
 120     if (any(r /= 0)) stop 74
 121   end subroutine
 122   subroutine check_minval_int
 123     integer(kind=2) :: a(3,2,0)
 124     logical(kind=1) :: m(3,2,0)
 125     integer :: i, j
 126     integer, allocatable :: r(:,:)
 127     a = reshape((/ integer(kind=2):: /), shape(a))
 128     m = reshape((/ logical(kind=1):: /), shape(m))
 129     i = 3
 130     r = minval(a, dim=i, mask=m)
 131     if (any(lbound(r) /= 1)) stop 81
 132     if (any(ubound(r) /= (/ 3, 2 /))) stop 82
 133     if (any(shape(r) /= (/ 3, 2 /))) stop 83
 134     if (any(r /= huge(1_2))) stop 84
 135   end subroutine
 136   subroutine check_minval_char
 137     character(kind=4) :: a(0,3,2)
 138     logical(kind=1) :: m(0,3,2)
 139     integer :: i
 140     character(kind=4), allocatable :: r(:,:)
 141     a = reshape((/ character(kind=4):: /), shape(a))
 142     m = reshape((/ logical(kind=1):: /), shape(m))
 143     i = 1
 144     r = minval(a, dim=i, mask=m)
 145     if (any(lbound(r) /= 1)) stop 91
 146     if (any(ubound(r) /= (/ 3, 2 /))) stop 92
 147     if (any(shape(r) /= (/ 3, 2 /))) stop 93
 148     if (any(r /= char(int(z'FFFFFFFF', kind=8), kind=4))) stop 94
 149   end subroutine
 150   subroutine check_maxval_real
 151     real(kind=8) :: a(0,2,3)
 152     logical(kind=1) :: m(0,2,3)
 153     integer :: i
 154     real(kind=8), allocatable :: r(:,:)
 155     a = reshape((/ real(kind=8):: /), shape(a))
 156     m = reshape((/ logical(kind=1):: /), shape(m))
 157     i = 1
 158     r = maxval(a, dim=i, mask=m)
 159     if (any(lbound(r) /= 1)) stop 101
 160     if (any(ubound(r) /= (/ 2, 3 /))) stop 102
 161     if (any(shape(r) /= (/ 2, 3 /))) stop 103
 162     if (any(r /= -huge(1._8))) stop 104
 163   end subroutine
 164   subroutine check_maxval_char
 165     character(kind=4,len=2) :: a(3,0,2), e
 166     logical(kind=1) :: m(3,0,2)
 167     integer :: i
 168     character(len=2,kind=4), allocatable :: r(:,:)
 169     a = reshape((/ character(kind=4,len=2):: /), shape(a))
 170     m = reshape((/ logical(kind=1):: /), shape(m))
 171     i = 2
 172     r = maxval(a, dim=i, mask=m)
 173     if (any(lbound(r) /= 1)) stop 111
 174     if (any(ubound(r) /= (/ 3, 2 /))) stop 112
 175     if (any(shape(r) /= (/ 3, 2 /))) stop 113
 176     e = repeat(char(0, kind=4), len(a))
 177     if (any(r /= e)) stop 114
 178   end subroutine
 179   subroutine check_sum
 180     integer(kind=1) :: a(2,3,0)
 181     logical(kind=1) :: m(2,3,0)
 182     integer :: i
 183     integer, allocatable :: r(:,:)
 184     a = reshape((/ integer:: /), shape(a))
 185     m = reshape((/ logical(kind=1):: /), shape(m))
 186     i = 3
 187     r = sum(a, dim=i, mask=m)
 188     if (any(lbound(r) /= 1)) stop 121
 189     if (any(ubound(r) /= (/ 2, 3 /))) stop 122
 190     if (any(shape(r) /= (/ 2, 3 /))) stop 123
 191     if (any(r /= 0)) stop 124
 192   end subroutine
 193   subroutine check_product
 194     real(kind=8) :: a(0,2,3)
 195     logical(kind=1) :: m(0,2,3)
 196     integer :: i
 197     integer, allocatable :: r(:,:)
 198     a = reshape((/ real(kind=8):: /), shape(a))
 199     m = reshape((/ logical(kind=1):: /), shape(m))
 200     i = 1
 201     r = product(a, dim=i, mask=m)
 202     if (any(lbound(r) /= 1)) stop 131
 203     if (any(ubound(r) /= (/ 2, 3 /))) stop 132
 204     if (any(shape(r) /= (/ 2, 3 /))) stop 133
 205     if (any(r /= 1.0_8)) stop 134
 206   end subroutine
 207 end program