1! { dg-do compile }
2! { dg-additional-options "-fmax-errors=100" }
3
4module test
5  implicit none
6contains
7
8  subroutine foo (vi)
9  logical :: l
10  integer, value :: vi
11  integer :: i, ia(10), a(10), b(2:8)
12  complex :: c, ca(10)
13  real, target:: r
14  real :: ra(10)
15  real, pointer :: rp
16  real, dimension(:), allocatable :: aa
17  type t
18  integer :: i
19  end type
20  type(t) :: ti
21  type(t), allocatable :: tia
22  type(t), target :: tit
23  type(t), pointer :: tip
24  rp => r
25  tip => tit
26
27  ! enter data
28  !$acc enter data
29  !$acc enter data if (.false.)
30  !$acc enter data if (l)
31  !$acc enter data if (.false.) if (l) ! { dg-error "Failed to match clause" }
32  !$acc enter data if (i) ! { dg-error "LOGICAL" }
33  !$acc enter data if (1) ! { dg-error "LOGICAL" }
34  !$acc enter data if (a) ! { dg-error "LOGICAL" }
35  !$acc enter data if (b(5:6)) ! { dg-error "LOGICAL" }
36  !$acc enter data async (l) ! { dg-error "INTEGER" }
37  !$acc enter data async (.true.) ! { dg-error "INTEGER" }
38  !$acc enter data async (1)
39  !$acc enter data async (i)
40  !$acc enter data async (a) ! { dg-error "INTEGER" }
41  !$acc enter data async (b(5:6)) ! { dg-error "INTEGER" }
42  !$acc enter data wait (l) ! { dg-error "INTEGER" }
43  !$acc enter data wait (.true.) ! { dg-error "INTEGER" }
44  !$acc enter data wait (i, 1)
45  !$acc enter data wait (a) ! { dg-error "INTEGER" }
46  !$acc enter data wait (b(5:6)) ! { dg-error "INTEGER" }
47  !$acc enter data copyin (tip)
48  !$acc enter data copyin (tia)
49  !$acc enter data create (tip)
50  !$acc enter data create (tia)
51  !$acc enter data present_or_copyin (tip)
52  !$acc enter data present_or_copyin (tia)
53  !$acc enter data present_or_create (tip)
54  !$acc enter data present_or_create (tia)
55  !$acc enter data copyin (i) create (i) ! { dg-error "multiple clauses" }
56  !$acc enter data copyin (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
57  !$acc enter data create (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
58  !$acc enter data copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
59  !$acc enter data create (i) present_or_create (i) ! { dg-error "multiple clauses" }
60  !$acc enter data present_or_copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
61
62  ! exit data
63  !$acc exit data
64  !$acc exit data if (.false.)
65  !$acc exit data if (l)
66  !$acc exit data if (.false.) if (l) ! { dg-error "Failed to match clause" }
67  !$acc exit data if (i) ! { dg-error "LOGICAL" }
68  !$acc exit data if (1) ! { dg-error "LOGICAL" }
69  !$acc exit data if (a) ! { dg-error "LOGICAL" }
70  !$acc exit data if (b(5:6)) ! { dg-error "LOGICAL" }
71  !$acc exit data async (l) ! { dg-error "INTEGER" }
72  !$acc exit data async (.true.) ! { dg-error "INTEGER" }
73  !$acc exit data async (1)
74  !$acc exit data async (i)
75  !$acc exit data async (a) ! { dg-error "INTEGER" }
76  !$acc exit data async (b(5:6)) ! { dg-error "INTEGER" }
77  !$acc exit data wait (l) ! { dg-error "INTEGER" }
78  !$acc exit data wait (.true.) ! { dg-error "INTEGER" }
79  !$acc exit data wait (i, 1)
80  !$acc exit data wait (a) ! { dg-error "INTEGER" }
81  !$acc exit data wait (b(5:6)) ! { dg-error "INTEGER" }
82  !$acc exit data copyout (tip)
83  !$acc exit data copyout (tia)
84  !$acc exit data delete (tip)
85  !$acc exit data delete (tia)
86  !$acc exit data copyout (i) delete (i) ! { dg-error "multiple clauses" }
87  !$acc exit data finalize
88  !$acc exit data finalize copyout (i)
89  !$acc exit data finalize delete (i)
90  end subroutine foo
91end module test
92