gcc/testsuite/gfortran.dg/allocated_4.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/112412
   4 ! The library used to not allocate memory for the result of transformational
   5 ! functions reducing an array along one dimension, if the result of the
   6 ! function was an empty array.  This caused the result to be seen as
   7 ! an unallocated array.
   8
   9 program p
  10   implicit none
  11   call check_iparity
  12   call check_sum
  13   call check_minloc_int
  14   call check_minloc_char
  15   call check_maxloc_char4
  16   call check_minval_char
  17   call check_maxval_char4
  18   call check_any
  19   call check_count4
  20 contains
  21   subroutine check_iparity
  22     integer :: a(9,3,0,7)
  23     logical :: m1(9,3,0,7)
  24     logical(kind=4) :: m4
  25     integer :: i
  26     integer, allocatable :: r(:,:,:)
  27     a  = reshape((/ integer:: /), shape(a))
  28     m1 = reshape((/ logical:: /), shape(m1))
  29     m4 = .false.
  30     i = 1
  31     r = iparity(a, dim=i)
  32     if (.not. allocated(r)) stop 11
  33     deallocate(r)
  34     i = 2
  35     r = iparity(a, dim=i, mask=m1)
  36     if (.not. allocated(r)) stop 12
  37     deallocate(r)
  38     i = 4
  39     r = iparity(a, dim=i, mask=m4)
  40     if (.not. allocated(r)) stop 13
  41     deallocate(r)
  42   end subroutine
  43   subroutine check_sum
  44     integer :: a(9,3,0,7)
  45     logical :: m1(9,3,0,7)
  46     logical(kind=4) :: m4
  47     integer :: i
  48     integer, allocatable :: r(:,:,:)
  49     a  = reshape((/ integer:: /), shape(a))
  50     m1 = reshape((/ logical:: /), shape(m1))
  51     m4 = .false.
  52     i = 2
  53     r = sum(a, dim=i)
  54     if (.not. allocated(r)) stop 21
  55     deallocate(r)
  56     i = 4
  57     r = sum(a, dim=i, mask=m1)
  58     if (.not. allocated(r)) stop 22
  59     deallocate(r)
  60     i = 1
  61     r = sum(a, dim=i, mask=m4)
  62     if (.not. allocated(r)) stop 23
  63     deallocate(r)
  64   end subroutine
  65   subroutine check_minloc_int
  66     integer :: a(9,3,0,7)
  67     logical :: m1(9,3,0,7)
  68     logical(kind=4) :: m4
  69     integer :: i
  70     integer, allocatable :: r(:,:,:)
  71     a  = reshape((/ integer:: /), shape(a))
  72     m1 = reshape((/ logical:: /), shape(m1))
  73     m4 = .false.
  74     i = 4
  75     r = minloc(a, dim=i)
  76     if (.not. allocated(r)) stop 31
  77     deallocate(r)
  78     i = 1
  79     r = minloc(a, dim=i, mask=m1)
  80     if (.not. allocated(r)) stop 32
  81     deallocate(r)
  82     i = 2
  83     r = minloc(a, dim=i, mask=m4)
  84     if (.not. allocated(r)) stop 33
  85     deallocate(r)
  86   end subroutine
  87   subroutine check_minloc_char
  88     character :: a(9,3,0,7)
  89     logical :: m1(9,3,0,7)
  90     logical(kind=4) :: m4
  91     integer :: i
  92     integer, allocatable :: r(:,:,:)
  93     a  = reshape((/ character:: /), shape(a))
  94     m1 = reshape((/ logical:: /), shape(m1))
  95     m4 = .false.
  96     i = 4
  97     r = minloc(a, dim=i)
  98     if (.not. allocated(r)) stop 41
  99     deallocate(r)
 100     i = 2
 101     r = minloc(a, dim=i, mask=m1)
 102     if (.not. allocated(r)) stop 42
 103     deallocate(r)
 104     i = 1
 105     r = minloc(a, dim=i, mask=m4)
 106     if (.not. allocated(r)) stop 43
 107     deallocate(r)
 108   end subroutine
 109   subroutine check_maxloc_char4
 110     character(kind=4) :: a(9,3,0,7)
 111     logical :: m1(9,3,0,7)
 112     logical(kind=4) :: m4
 113     integer :: i
 114     integer, allocatable :: r(:,:,:)
 115     a  = reshape((/ character(kind=4):: /), shape(a))
 116     m1 = reshape((/ logical:: /), shape(m1))
 117     m4 = .false.
 118     i = 1
 119     r = maxloc(a, dim=i)
 120     if (.not. allocated(r)) stop 51
 121     deallocate(r)
 122     i = 4
 123     r = maxloc(a, dim=i, mask=m1)
 124     if (.not. allocated(r)) stop 52
 125     deallocate(r)
 126     i = 2
 127     r = maxloc(a, dim=i, mask=m4)
 128     if (.not. allocated(r)) stop 53
 129     deallocate(r)
 130   end subroutine
 131   subroutine check_minval_char
 132     character :: a(9,3,0,7)
 133     logical :: m1(9,3,0,7)
 134     logical(kind=4) :: m4
 135     integer :: i
 136     character, allocatable :: r(:,:,:)
 137     a  = reshape((/ character:: /), shape(a))
 138     m1 = reshape((/ logical:: /), shape(m1))
 139     m4 = .false.
 140     i = 2
 141     r = minval(a, dim=i)
 142     if (.not. allocated(r)) stop 61
 143     deallocate(r)
 144     i = 1
 145     r = minval(a, dim=i, mask=m1)
 146     if (.not. allocated(r)) stop 62
 147     deallocate(r)
 148     i = 4
 149     r = minval(a, dim=i, mask=m4)
 150     if (.not. allocated(r)) stop 63
 151     deallocate(r)
 152   end subroutine
 153   subroutine check_maxval_char4
 154     character(kind=4) :: a(9,3,0,7)
 155     logical :: m1(9,3,0,7)
 156     logical(kind=4) :: m4
 157     integer :: i
 158     character(kind=4), allocatable :: r(:,:,:)
 159     a  = reshape((/ character(kind=4):: /), shape(a))
 160     m1 = reshape((/ logical:: /), shape(m1))
 161     m4 = .false.
 162     i = 1
 163     r = maxval(a, dim=i)
 164     if (.not. allocated(r)) stop 71
 165     deallocate(r)
 166     i = 2
 167     r = maxval(a, dim=i, mask=m1)
 168     if (.not. allocated(r)) stop 72
 169     deallocate(r)
 170     i = 4
 171     r = maxval(a, dim=i, mask=m4)
 172     if (.not. allocated(r)) stop 73
 173     deallocate(r)
 174   end subroutine
 175   subroutine check_any
 176     logical :: a(9,3,0,7)
 177     integer :: i
 178     logical, allocatable :: r(:,:,:)
 179     a  = reshape((/ logical:: /), shape(a))
 180     i = 2
 181     r = any(a, dim=i)
 182     if (.not. allocated(r)) stop 81
 183     deallocate(r)
 184   end subroutine
 185   subroutine check_count4
 186     logical(kind=4) :: a(9,3,0,7)
 187     integer :: i
 188     integer, allocatable :: r(:,:,:)
 189     a  = reshape((/ logical(kind=4):: /), shape(a))
 190     i = 4
 191     r = count(a, dim=i)
 192     if (.not. allocated(r)) stop 91
 193     deallocate(r)
 194   end subroutine
 195 end program