1! { dg-do run }
2!
3implicit none (type, external)
4integer, allocatable :: a_ii, a_ival, a_iarr(:)
5integer, pointer :: p_ii, p_ival, p_iarr(:)
6
7nullify (p_ii, p_ival, p_iarr)
8
9call sub()
10call sub2()
11call call_present_1()
12call call_present_2()
13
14! unallocated/disassociated actual arguments to nonallocatable, nonpointer
15! dummy arguments are regarded as absent
16! Skipping 'ival' dummy argument due to PR fortran/92887
17call sub(ii=a_ii, iarr=a_iarr)
18call sub(ii=p_ii, iarr=p_iarr)
19call sub2(ii=a_ii, iarr=a_iarr)
20call sub2(ii=p_ii, iarr=p_iarr)
21
22contains
23
24subroutine call_present_1()
25  integer :: ii, ival, iarr, iptr, iparr
26  pointer :: iptr, iparr
27  dimension :: iarr(2), iparr(:)
28  allocate(iptr,iparr(2))
29  ii = 101
30  ival = 102
31  iptr = 103
32  iarr = 104
33  iparr = 105
34  call sub_present(ii, ival, iarr, iptr, iparr)
35  deallocate(iptr,iparr)
36end subroutine
37
38subroutine call_present_2()
39  integer :: ii, ival, iarr, iptr, iparr
40  pointer :: iptr, iparr
41  dimension :: iarr(2), iparr(:)
42  allocate(iptr,iparr(2))
43  ii = 201
44  ival = 202
45  iptr = 203
46  iarr = 204
47  iparr = 205
48  call sub2_present(ii, ival, iarr, iptr, iparr)
49  deallocate(iptr,iparr)
50end subroutine
51
52subroutine sub(ii, ival, iarr, iptr, iparr)
53  integer, optional :: ii, ival, iarr, iptr, iparr
54  pointer :: iptr, iparr
55  dimension :: iarr(:), iparr(:)
56  value :: ival
57  integer :: err
58  err = 42
59  !$omp target map(ii, ival, iarr, iptr, iparr, err)
60  if (present(ii)) then
61    ii = iptr + ival
62    iarr = iparr
63  else
64    err = 0
65  end if
66  if (present(ii)) err = 1
67  if (present(ival)) err = 2
68  if (present(iarr)) err = 3
69  if (present(iptr)) err = 4
70  if (present(iparr)) err = 5
71  !$omp end target
72  if (err /= 0) stop 1
73end subroutine sub
74
75subroutine sub2(ii, ival, iarr, iptr, iparr)
76  integer, optional :: ii, ival, iarr, iptr, iparr
77  pointer :: iptr, iparr
78  dimension :: iarr(:), iparr(:)
79  value :: ival
80  integer :: err(1) ! otherwise, implied defaultmap is firstprivate
81  err(1) = 42
82  !$omp target  ! automatic mapping with implied defaultmap(tofrom)
83  if (present(ii)) then
84    ii = iptr + ival
85    iarr = iparr
86  else
87    err(1) = 0
88  end if
89  if (present(ii)) err(1) = 1
90  if (present(ival)) err(1) = 2
91  if (present(iarr)) err(1) = 3
92  if (present(iptr)) err(1) = 4
93  if (present(iparr)) err(1) = 5
94  !$omp end target
95  if (err(1) /= 0) stop 2
96end subroutine sub2
97
98subroutine sub_present(ii, ival, iarr, iptr, iparr)
99  integer, optional :: ii, ival, iarr, iptr, iparr
100  pointer :: iptr, iparr
101  dimension :: iarr(:), iparr(:)
102  value :: ival
103  integer :: err
104  err = 42
105  !$omp target map(ii, ival, iarr, iptr, iparr, err)
106  if (.not.present(ii)) err = 1
107  if (.not.present(ival)) err = 2
108  if (.not.present(iarr)) err = 3
109  if (.not.present(iptr)) err = 4
110  if (.not.present(iparr)) err = 5
111  err = err - 42 - 101-102-103-104-105 + ii+ival+iarr(2)+iptr+iparr(2)
112  !$omp end target
113  if (err /= 0) stop 3
114end subroutine sub_present
115
116subroutine sub2_present(ii, ival, iarr, iptr, iparr)
117  integer, optional :: ii, ival, iarr, iptr, iparr
118  pointer :: iptr, iparr
119  dimension :: iarr(:), iparr(:)
120  value :: ival
121  integer :: err(1) ! otherwise, implied defaultmap is firstprivate
122  err(1) = 53
123  !$omp target  ! automatic mapping with implied defaultmap(tofrom)
124  ! Note: OpenMP 4.5's 'defaultmap' is not yet supported, PR 92568
125  if (.not.present(ii)) err = 1
126  if (.not.present(ival)) err = 2
127  if (.not.present(iarr)) err = 3
128  if (.not.present(iptr)) err = 4
129  if (.not.present(iparr)) err = 5
130  err = err - 53 - 201-202-203-204-205 + ii+ival+iarr(2)+iptr+iparr(2)
131  !$omp end target
132  if (err(1) /= 0) stop 4
133end subroutine sub2_present
134end
135