libgomp/testsuite/libgomp.fortran/alloc-comp-1.f90

   1 ! { dg-do run }
   2 ! Don't cycle by default through all options, just test -O0 and -O2,
   3 ! as this is quite large test.
   4 ! { dg-skip-if "" { ! run_expensive_tests } { "*" } { "-O0" "-O2" } }
   5
   6 module m
   7   type dl
   8     integer :: a, b
   9     integer, allocatable :: c(:,:)
  10     integer :: d, e
  11     integer, allocatable :: f
  12   end type
  13   type dt
  14     integer :: g
  15     type (dl), allocatable :: h(:)
  16     integer :: i
  17     type (dl) :: j(2, 2)
  18     type (dl), allocatable :: k
  19   end type
  20 contains
  21   subroutine ver_dl (obj, val, c, cl1, cu1, cl2, cu2, f)
  22     type (dl), intent (in) :: obj
  23     integer, intent (in) :: val, cl1, cu1, cl2, cu2
  24     logical, intent (in) :: c, f
  25     if ((c .neqv. allocated (obj%c)) .or. (f .neqv. allocated (obj%f))) STOP 1
  26     if (c) then
  27       if (lbound (obj%c, 1) /= cl1 .or. ubound (obj%c, 1) /= cu1) STOP 2
  28       if (lbound (obj%c, 2) /= cl2 .or. ubound (obj%c, 2) /= cu2) STOP 3
  29     end if
  30     if (val /= 0) then
  31       if (obj%a /= val .or. obj%b /= val) STOP 4
  32       if (obj%d /= val .or. obj%e /= val) STOP 5
  33       if (c) then
  34         if (any (obj%c /= val)) STOP 6
  35       end if
  36       if (f) then
  37         if (obj%f /= val) STOP 7
  38       end if
  39     end if
  40   end subroutine ver_dl
  41   subroutine ver_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f)
  42     type (dt), intent (in) :: obj
  43     integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2
  44     logical, intent (in) :: h, k, c, f
  45     integer :: i, j
  46     if ((h .neqv. allocated (obj%h)) .or. (k .neqv. allocated (obj%k))) STOP 8
  47     if (h) then
  48       if (lbound (obj%h, 1) /= hl .or. ubound (obj%h, 1) /= hu) STOP 9
  49       do i = hl, hu
  50         call ver_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f)
  51       end do
  52     end if
  53     do i = 1, 2
  54       do j = 1, 2
  55         call ver_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f)
  56       end do
  57     end do
  58     if (k) call ver_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f)
  59     if (val /= 0) then
  60       if (obj%g /= val .or. obj%i /= val) STOP 10
  61     end if
  62   end subroutine ver_dt
  63   subroutine alloc_dl (obj, val, c, cl1, cu1, cl2, cu2, f)
  64     type (dl), intent (inout) :: obj
  65     integer, intent (in) :: val, cl1, cu1, cl2, cu2
  66     logical, intent (in) :: c, f
  67     if (val /= 0) then
  68       obj%a = val
  69       obj%b = val
  70       obj%d = val
  71       obj%e = val
  72     end if
  73     if (allocated (obj%c)) deallocate (obj%c)
  74     if (c) then
  75       allocate (obj%c(cl1:cu1, cl2:cu2))
  76       if (val /= 0) obj%c = val
  77     end if
  78     if (f) then
  79       if (.not.allocated (obj%f)) allocate (obj%f)
  80       if (val /= 0) obj%f = val
  81     else
  82       if (allocated (obj%f)) deallocate (obj%f)
  83     end if
  84   end subroutine alloc_dl
  85   subroutine alloc_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f)
  86     type (dt), intent (inout) :: obj
  87     integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2
  88     logical, intent (in) :: h, k, c, f
  89     integer :: i, j
  90     if (val /= 0) then
  91       obj%g = val
  92       obj%i = val
  93     end if
  94     if (allocated (obj%h)) deallocate (obj%h)
  95     if (h) then
  96       allocate (obj%h(hl:hu))
  97       do i = hl, hu
  98         call alloc_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f)
  99       end do
 100     end if
 101     do i = 1, 2
 102       do j = 1, 2
 103         call alloc_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f)
 104       end do
 105     end do
 106     if (k) then
 107       if (.not.allocated (obj%k)) allocate (obj%k)
 108       call alloc_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f)
 109     else
 110       if (allocated (obj%k)) deallocate (obj%k)
 111     end if
 112   end subroutine alloc_dt
 113 end module m
 114   use m
 115   type (dt) :: y
 116   call foo (y)
 117 contains
 118   subroutine foo (y)
 119     use m
 120     type (dt) :: x, y, z(-3:-3,2:3)
 121     logical, parameter :: F = .false.
 122     logical, parameter :: T = .true.
 123     logical :: l
 124     call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 125     call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 126     call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 127     call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 128 !$omp parallel private (x, y, z)
 129     call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 130     call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 131     call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 132     call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 133     call alloc_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T)
 134     call ver_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T)
 135     call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 136     call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 137     call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 138     call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 139     call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T)
 140     call ver_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T)
 141 !$omp end parallel
 142     call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 143     call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 144     call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 145     call alloc_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T)
 146     call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 147     call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 148     call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 149     call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T)
 150 !$omp parallel private (x, y, z)
 151     call ver_dt (x, 0, T, -3, -1, T, T, -1, -1, 2, 3, T)
 152     call ver_dt (y, 0, T, 3, 4, F, T, 1, 1, 2, 4, T)
 153     deallocate (x%h, x%k)
 154     deallocate (y%h)
 155     allocate (y%k)
 156     call ver_dt (z(-3,2), 0, T, -3, -1, T, T, -1, -1, 2, 3, T)
 157     call ver_dt (z(-3,3), 0, T, 3, 4, F, T, 1, 1, 2, 4, T)
 158     deallocate (z(-3,2)%h, z(-3,2)%k)
 159     deallocate (z(-3,3)%h)
 160     allocate (z(-3,3)%k)
 161 !$omp end parallel
 162     call alloc_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F)
 163     call alloc_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T)
 164     call alloc_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F)
 165     call alloc_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T)
 166 !$omp parallel firstprivate (x, y, z)
 167     call ver_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F)
 168     call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 169     call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 170     call ver_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T)
 171     call alloc_dt (y, 4, T, 3, 4, T, T, 1, 1, 2, 4, T)
 172     call ver_dt (y, 4, T, 3, 4, T, T, 1, 1, 2, 4, T)
 173     call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F)
 174     call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 175     call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 176     call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T)
 177     call alloc_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T)
 178     call ver_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T)
 179 !$omp end parallel
 180     call ver_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F)
 181     call alloc_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F)
 182     call ver_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T)
 183     call alloc_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F)
 184     call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F)
 185     call alloc_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F)
 186     call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T)
 187     call alloc_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F)
 188 !$omp parallel firstprivate (x, y, z)
 189     call ver_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F)
 190     call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 191     call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 192     call ver_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F)
 193     call alloc_dt (y, 17, T, 1, 2, F, T, 2, 2, 3, 3, F)
 194     call ver_dt (y, 17, T, 1, 2, F, T, 2, 2, 3, 3, F)
 195     call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F)
 196     call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 197     call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T)
 198     call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F)
 199     call alloc_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F)
 200     call ver_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F)
 201 !$omp end parallel
 202     call ver_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F)
 203     call ver_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F)
 204     call alloc_dt (y, 18, T, 0, 1, T, T, 0, 1, 0, 1, T)
 205     call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F)
 206     call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F)
 207     call alloc_dt (z(-3,3), 18, T, 0, 1, T, T, 0, 1, 0, 1, T)
 208     l = F
 209 !$omp parallel sections lastprivate (x, y, z) firstprivate (l)
 210 !$omp section
 211     if (l) then
 212       call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T)
 213       call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T)
 214       call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T)
 215       call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T)
 216     else
 217       call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 218       call ver_dt (y, 0, T, 0, 1, T, T, 0, 1, 0, 1, T)
 219       call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 220       call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T)
 221     end if
 222     l = T
 223     call alloc_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T)
 224     call ver_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T)
 225     call alloc_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F)
 226     call ver_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F)
 227     call alloc_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T)
 228     call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T)
 229     call alloc_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F)
 230     call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F)
 231 !$omp section
 232     if (l) then
 233       call ver_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T)
 234       call ver_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F)
 235       call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T)
 236       call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F)
 237     else
 238       call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 239       call ver_dt (y, 0, T, 0, 1, T, T, 0, 1, 0, 1, T)
 240       call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F)
 241       call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T)
 242     end if
 243     l = T
 244     call alloc_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T)
 245     call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T)
 246     call alloc_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T)
 247     call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T)
 248     call alloc_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T)
 249     call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T)
 250     call alloc_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T)
 251     call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T)
 252 !$omp section
 253 !$omp end parallel sections
 254     call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T)
 255     call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T)
 256     call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T)
 257     call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T)
 258 !$omp parallel sections lastprivate (x, y, z) firstprivate (l)
 259 !$omp section
 260     if (l) then
 261       call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T)
 262       call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F)
 263       call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T)
 264       call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F)
 265     else
 266       call ver_dt (x, 0, T, 1, 1, F, F, 0, 0, 0, 0, T)
 267       call ver_dt (y, 0, F, 0, 0, T, T, 1, 2, 3, 4, T)
 268       call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T)
 269       call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T)
 270     end if
 271     l = T
 272     call alloc_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F)
 273     call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F)
 274     call alloc_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T)
 275     call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T)
 276     call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F)
 277     call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F)
 278     call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T)
 279     call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T)
 280 !$omp section
 281     if (l) then
 282       call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F)
 283       call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T)
 284       call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F)
 285       call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T)
 286     else
 287       call ver_dt (x, 0, T, 1, 1, F, F, 0, 0, 0, 0, T)
 288       call ver_dt (y, 0, F, 0, 0, T, T, 1, 2, 3, 4, T)
 289       call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T)
 290       call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T)
 291     end if
 292     l = T
 293     call alloc_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T)
 294     call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T)
 295     call alloc_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F)
 296     call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F)
 297     call alloc_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T)
 298     call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T)
 299     call alloc_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F)
 300     call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F)
 301 !$omp section
 302 !$omp end parallel sections
 303     call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T)
 304     call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F)
 305     call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T)
 306     call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F)
 307 !$omp parallel private (x, y, z)
 308     call ver_dt (x, 0, F, 0, 0, T, T, -1, -1, -1, -1, T)
 309     call ver_dt (y, 0, T, 0, 1, T, T, 2, 2, 2, 2, F)
 310     call ver_dt (z(-3,2), 0, F, 0, 0, T, T, -1, -1, -1, -1, T)
 311     call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 2, 2, 2, 2, F)
 312 !$omp single
 313     call alloc_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F)
 314     call alloc_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T)
 315     call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F)
 316     call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T)
 317 !$omp end single copyprivate (x, y, z)
 318     call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F)
 319     call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T)
 320     call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F)
 321     call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T)
 322 !$omp end parallel
 323     call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T)
 324     call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F)
 325     call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T)
 326     call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F)
 327   end subroutine foo
 328 end