gcc/testsuite/gfortran.dg/gomp/allocate-1.f90

   1 ! { dg-do compile }
   2
   3 module omp_lib_kinds
   4   use iso_c_binding, only: c_int, c_intptr_t
   5   implicit none
   6   private :: c_int, c_intptr_t
   7   integer, parameter :: omp_allocator_handle_kind = c_intptr_t
   8
   9   integer (kind=omp_allocator_handle_kind), &
  10      parameter :: omp_null_allocator = 0
  11   integer (kind=omp_allocator_handle_kind), &
  12      parameter :: omp_default_mem_alloc = 1
  13   integer (kind=omp_allocator_handle_kind), &
  14      parameter :: omp_large_cap_mem_alloc = 2
  15   integer (kind=omp_allocator_handle_kind), &
  16      parameter :: omp_const_mem_alloc = 3
  17   integer (kind=omp_allocator_handle_kind), &
  18      parameter :: omp_high_bw_mem_alloc = 4
  19   integer (kind=omp_allocator_handle_kind), &
  20      parameter :: omp_low_lat_mem_alloc = 5
  21   integer (kind=omp_allocator_handle_kind), &
  22      parameter :: omp_cgroup_mem_alloc = 6
  23   integer (kind=omp_allocator_handle_kind), &
  24      parameter :: omp_pteam_mem_alloc = 7
  25   integer (kind=omp_allocator_handle_kind), &
  26      parameter :: omp_thread_mem_alloc = 8
  27 end module
  28
  29 subroutine bar (a, b, c)
  30   implicit none
  31   integer  :: a
  32   integer  :: b
  33   integer  :: c
  34   c = a + b
  35 end
  36
  37 subroutine bar2 (a, b, c)
  38   implicit none
  39   integer  :: a
  40   integer  :: b(15)
  41   integer  :: c
  42   c = a + b(1)
  43 end
  44
  45 subroutine foo(x, y)
  46   use omp_lib_kinds
  47   implicit none
  48   integer  :: x
  49   integer  :: z
  50
  51   integer, dimension(15) :: y
  52   integer  :: r
  53   integer  :: i
  54   integer  c1, c2, c3, c4
  55   integer (kind=omp_allocator_handle_kind) :: h
  56   common /B1/ c1, c2
  57   common /B2/ c3, c4
  58
  59   r = 0
  60   h = omp_default_mem_alloc;
  61
  62
  63   !$omp parallel private(/B1/, c3, c4) allocate(/B1/, /B2/)
  64   !$omp end parallel
  65
  66   !$omp parallel private(/B1/, /B2/) allocate(h:/B1/, /B2/)
  67   !$omp end parallel
  68
  69   !$omp parallel private(/B1/, /B2/) allocate(omp_large_cap_mem_alloc:/B1/, c3, c4)
  70   !$omp end parallel
  71
  72   !$omp parallel allocate (x) allocate (h : y) &
  73   !$omp  allocate (omp_large_cap_mem_alloc:z) firstprivate (x, y, z)
  74   call bar2 (x, y, z);
  75   !$omp end parallel
  76
  77   !$omp task private (x) firstprivate (z) allocate (omp_low_lat_mem_alloc:x,z)
  78   call bar (0, x, z);
  79   !$omp end task
  80
  81   !$omp target teams distribute parallel do private (x) firstprivate (y) &
  82   !$omp allocate ((omp_default_mem_alloc + 0):z) allocate &
  83   !$omp (omp_default_mem_alloc: x, y) allocate (h: r) lastprivate (z) reduction(+:r)
  84   do i = 1, 10
  85     call bar (0, x, z);
  86     call bar2 (1, y, r);
  87   end do
  88   !$omp end target teams distribute parallel do
  89
  90   !$omp single private (x) allocate (omp_low_lat_mem_alloc:x)
  91   x=1
  92   !$omp end single
  93
  94   !$omp single allocate (omp_low_lat_mem_alloc:x) private (x)
  95   !$omp end single
  96
  97   !$omp parallel
  98   !$omp do allocate (x) private (x)
  99   do i = 1, 64
 100     x = 1;
 101   end do
 102   !$omp end parallel
 103
 104   !$omp sections private (x) allocate (omp_low_lat_mem_alloc: x)
 105     x = 1;
 106     !$omp section
 107     x = 2;
 108     !$omp section
 109     x = 3;
 110   !$omp end sections
 111
 112   !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r)
 113   call bar (r, r, r);
 114   !$omp end taskgroup
 115
 116   !$omp teams private (x) firstprivate (y) allocate (h : x, y)
 117   call bar2 (x, y, r);
 118   !$omp end teams
 119
 120   !$omp taskloop lastprivate (x) reduction (+:r) allocate (h : x, r)
 121   do i = 1, 16
 122     call bar (0, r, r);
 123     x = i;
 124   end do
 125   !$omp end taskloop
 126
 127   !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r)
 128   !$omp taskloop firstprivate (x) in_reduction (+:r) &
 129   !$omp allocate (omp_default_mem_alloc : x, r)
 130   do i = 1, 16
 131     call bar (x, r, r);
 132   end do
 133   !$omp end taskloop
 134   !$omp end taskgroup
 135   !$omp taskwait
 136 end subroutine
 137