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

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