libgomp/testsuite/libgomp.fortran/allocate-6.f90

   1 ! { dg-additional-options "-fdump-tree-gimple" }
   2 module m
   3   use iso_c_binding
   4   use omp_lib
   5   implicit none (type, external)
   6   integer(c_intptr_t) :: intptr
   7
   8 ! { dg-final { scan-tree-dump-not "__builtin_stack_save" "gimple" } }
   9 ! { dg-final { scan-tree-dump-not "__builtin_alloca" "gimple" } }
  10 ! { dg-final { scan-tree-dump-not "__builtin_stack_restore" "gimple" } }
  11
  12 ! { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc \\(" 5 "gimple" } }
  13 ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(" 5 "gimple" } }
  14
  15 contains
  16
  17 subroutine one ()
  18   integer :: result, n, i
  19   result = 0
  20   n = 3
  21   !$omp target map(tofrom: result) firstprivate(n)
  22     block
  23       integer :: var, var2(n)
  24       !$omp allocate(var,var2) align(128) allocator(omp_low_lat_mem_alloc)
  25       var = 5
  26 ! { dg-final { scan-tree-dump-times "var\\.\[0-9\]+ = __builtin_GOMP_alloc \\(128, 4, 5\\);" 1 "gimple" } } */
  27 ! { dg-final { scan-tree-dump-times "var2 = __builtin_GOMP_alloc \\(128, D\\.\[0-9\]+, 5\\);" 1 "gimple" } } */
  28
  29 ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(var\\.\[0-9\]+, 0B\\);" 1 "gimple" } } */
  30 ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(var2, 0B\\);" 1 "gimple" } } */
  31
  32       if (mod(transfer(loc(var), intptr), 128_c_intptr_t) /= 0) &
  33         stop 1
  34       if (mod(transfer(loc(var2), intptr), 128_c_intptr_t) /= 0) &
  35         stop 2
  36       if (var /= 5) &
  37         stop 3
  38
  39       !$omp parallel do
  40       do i = 1, n
  41         var2(i) = (i+32);
  42       end do
  43
  44       !$omp parallel loop reduction(+:result)
  45       do i = 1, n
  46         result = result + var + var2(i)
  47       end do
  48     end block
  49   if (result /= (3*5 + 33 + 34 + 35)) &
  50     stop 4
  51 end
  52
  53 subroutine two ()
  54   type st
  55     integer :: a, b
  56   end type
  57   integer :: scalar, array(5), i
  58   type(st) s
  59   !$omp allocate(scalar, array, s)
  60 ! { dg-final { scan-tree-dump-times "scalar\\.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 4, 0B\\);" 1 "gimple" } }
  61 ! { dg-final { scan-tree-dump-times "array\\.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 20, 0B\\);" 1 "gimple" } }
  62 ! { dg-final { scan-tree-dump-times "s\\.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 8, 0B\\);" 1 "gimple" } }
  63 ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(scalar\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
  64 ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(array\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
  65 ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(s\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
  66
  67   scalar = 44
  68   array = [1,2,3,4,5]
  69   s = st(a=11, b=56)
  70
  71   !$omp parallel firstprivate(scalar) firstprivate(array) firstprivate(s)
  72     if (scalar /= 44) &
  73       stop 5
  74     scalar = 33;
  75     if (any (array /= [1,2,3,4,5])) &
  76       stop 6
  77     array = [10,20,30,40,50]
  78     if (s%a /= 11 .or. s%b /= 56) &
  79       stop 7
  80     s%a = 74
  81     s%b = 674
  82   !$omp end parallel
  83
  84   if (scalar /= 44) &
  85     stop 8
  86   if (any (array /= [1,2,3,4,5])) &
  87     stop 9
  88   if (s%a /= 11 .or. s%b /= 56) &
  89     stop 10
  90
  91   !$omp target defaultmap(firstprivate : scalar) defaultmap(none : aggregate) defaultmap(none : pointer)
  92     if (scalar /= 44) &
  93       stop 11
  94     scalar = 33;
  95   !$omp end target
  96
  97   if (scalar /= 44) &
  98     stop 12
  99
 100   !$omp target defaultmap(none : scalar) defaultmap(firstprivate : aggregate) defaultmap(none : pointer) private(i)
 101     if (any (array /= [1,2,3,4,5])) &
 102       stop 13
 103     do i = 1, 5
 104       array(i) = 10*i
 105     end do
 106   !$omp end target
 107
 108   if (any(array /= [1,2,3,4,5])) &
 109     stop 13
 110   !$omp target defaultmap(none : scalar) defaultmap(firstprivate : aggregate) defaultmap(none : pointer)
 111     if (s%a /= 11 .or. s%b /= 56) &
 112       stop 14
 113     s%a = 74
 114     s%b = 674
 115   !$omp end target
 116   if (s%a /= 11 .or. s%b /= 56) &
 117     stop 15
 118 end
 119 end module
 120
 121 use m
 122   call one ()
 123   call two ()
 124 end