libgomp/testsuite/libgomp.oacc-fortran/allocatable-1-2.f90

   1 ! Test 'allocatable' with OpenACC data clauses, subroutine in module, pass by
   2 ! reference.
   3
   4 ! See also '../libgomp.fortran/target-allocatable-1-2.f90'.
   5
   6 ! { dg-do run }
   7 ! { dg-additional-options "-cpp" }
   8
   9 module m
  10 contains
  11   subroutine r (a, b, c, d, e)
  12     implicit none
  13     integer, allocatable :: a, b, c, d, e
  14
  15     !$acc parallel copyin(a) copy(b, c, d) copyout(e)
  16
  17     if (.not. allocated (a)) stop 1
  18     if (a .ne. 11) stop 2
  19     a = 33
  20
  21     if (.not. allocated (b)) stop 3
  22     if (b .ne. 25) stop 4
  23
  24     if (.not. allocated (c)) stop 5
  25     if (c .ne. 52) stop 6
  26     c = 10
  27
  28     if (allocated (d)) stop 7
  29     d = 42 ! Implicit allocation, but on device only.
  30     if (.not. allocated (d)) stop 8
  31     deallocate (d) ! OpenMP requires must be "unallocated upon exit from the region".
  32
  33     if (allocated (e)) stop 9
  34     e = 24 ! Implicit allocation, but on device only.
  35     if (.not. allocated (e)) stop 10
  36     deallocate (e) ! OpenMP requires must be "unallocated upon exit from the region".
  37
  38     !$acc end parallel
  39
  40   end subroutine r
  41 end module m
  42
  43 program main
  44   use m
  45   implicit none
  46   integer, allocatable :: a, b, c, d, e
  47
  48   allocate (a)
  49   a = 11
  50
  51   b = 25 ! Implicit allocation.
  52
  53   c = 52 ! Implicit allocation.
  54
  55   !No 'allocate (d)' here.
  56
  57   !No 'allocate (e)' here.
  58
  59   call r(a, b, c, d, e)
  60
  61   if (.not. allocated (a)) stop 20
  62 #if ACC_MEM_SHARED
  63   if (a .ne. 33) stop 21
  64 #else
  65   if (a .ne. 11) stop 22
  66 #endif
  67   deallocate (a)
  68
  69   if (.not. allocated (b)) stop 23
  70   if (b .ne. 25) stop 24
  71   deallocate (b)
  72
  73   if (.not. allocated (c)) stop 25
  74   if (c .ne. 10) stop 26
  75   deallocate (c)
  76
  77   if (allocated (d)) stop 27
  78
  79   if (allocated (e)) stop 28
  80
  81 end program main