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