libgomp/testsuite/libgomp.fortran/map-alloc-ptr-2.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/96668
   4
   5 module m
   6   implicit none
   7   integer, pointer :: p1(:) => null(), p3(:) => null()
   8   integer, allocatable :: a1(:), a2(:)
   9   !$omp declare target to(a1, a2, p1, p3)
  10 end module m
  11
  12 use m
  13 implicit none
  14   integer, pointer :: p2(:)
  15
  16   !$omp target
  17     if (allocated (a1)) stop 1
  18     if (allocated (a2)) stop 1
  19     if (associated (p1)) stop 1
  20     if (associated (p3)) stop 1
  21   !$omp end target
  22
  23   allocate (a1, source=[10,11,12,13,14])
  24   allocate (a2, source=[10,11,12,13,14])
  25   allocate (p1, source=[9,8,7,6,5,4])
  26   allocate (p3, source=[4,5,6])
  27   p2 => p1
  28
  29   !$omp target enter data map(to:p3)
  30
  31   ! allocatable, TR9 requires 'always' modifier:
  32   !$omp target map(always, tofrom: a1)
  33     if (.not. allocated(a1)) stop 2
  34     if (size(a1) /= 5) stop 3
  35     if (any (a1 /= [10,11,12,13,14])) stop 5
  36     a1(:) = [101, 102, 103, 104, 105]
  37   !$omp end target
  38
  39   ! allocatable, extension (OpenMP 6.0?): without 'always'
  40   !$omp target
  41     if (.not. allocated(a2)) stop 2
  42     if (size(a2) /= 5) stop 3
  43     if (any (a2 /= [10,11,12,13,14])) stop 5
  44     a2(:) = [101, 102, 103, 104, 105]
  45   !$omp end target
  46
  47   ! pointer: target is automatically mapped
  48   ! without requiring an explicit mapping or even the always modifier
  49   !$omp target  !! map(always, tofrom: p1)
  50     if (.not. associated(p1)) stop 7
  51     if (size(p1) /= 6) stop 8
  52     if (any (p1 /= [9,8,7,6,5,4])) stop 10
  53     p1(:) = [-1, -2, -3, -4, -5, -6]
  54   !$omp end target
  55
  56   !$omp target  !! map(always, tofrom: p3)
  57     if (.not. associated(p3)) stop 7
  58     if (size(p3) /= 3) stop 8
  59     if (any (p3 /= [4,5,6])) stop 10
  60     p3(:) = [23,24,25]
  61   !$omp end target
  62
  63   !$omp target update from(p1)
  64   if (any (p1 /= [-1, -2, -3, -4, -5, -6])) stop 141
  65
  66   !$omp target exit data map(always, from:p3)
  67   if (any (p3 /= [23,24,25])) stop 141
  68
  69   allocate (p1, source=[99,88,77,66,55,44,33])
  70
  71   !$omp target  ! And this also should work
  72     if (.not. associated(p1)) stop 7
  73     if (size(p1) /= 7) stop 8
  74     if (any (p1 /= [99,88,77,66,55,44,33])) stop 10
  75     p1(:) = [-11, -22, -33, -44, -55, -66, -77]
  76   !$omp end target
  77   !$omp target update from(p1)
  78
  79   if (any (a1 /= [101, 102, 103, 104, 105])) stop 12
  80   if (any (a2 /= [101, 102, 103, 104, 105])) stop 12
  81
  82   if (any (p1 /= [-11, -22, -33, -44, -55, -66, -77])) stop 142
  83   if (any (p2 /= [-1, -2, -3, -4, -5, -6])) stop 143
  84
  85   deallocate(a1, a2, p1, p2, p3)
  86 end