1! { dg-do compile }
2! { dg-additional-options "-fdump-tree-original" }
3
4subroutine f1
5  !$omp declare target device_type (any)  ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE clause is ignored" }
6end subroutine
7
8subroutine f2
9  !$omp declare target to (f2) device_type (any)
10end subroutine
11
12subroutine f3
13  !$omp declare target device_type (any) to (f3)
14end subroutine
15
16subroutine f4
17  !$omp declare target device_type (host) to (f4)
18end subroutine
19
20subroutine f5
21  !$omp declare target device_type (nohost) to (f5)
22end subroutine
23
24module mymod
25  ! device_type is ignored for variables in OpenMP 5.0
26  ! but TR8 and later apply those rules to variables as well
27  implicit none
28  integer :: a, b(4), c, d
29  integer :: e, f, g
30  integer :: m, n, o, p, q, r, s, t, u, v, w, x
31  common /block1/ m, n
32  common /block2/ o, p
33  common /block3/ q, r
34  common /block4/ s, t
35  common /block5/ u, v
36  common /block6/ w, x
37
38  !$omp declare target to(a) device_type(nohost)
39  !$omp declare target to(b) device_type(host)
40  !$omp declare target to(c) device_type(any)
41 ! Fails in ME with "Error: wrong number of arguments specified for 'omp declare target link' attribute"
42 ! !$omp declare target link(e) device_type(nohost)
43 ! !$omp declare target link(f) device_type(host)
44 ! !$omp declare target link(g) device_type(any)
45
46  !$omp declare target to(/block1/) device_type(nohost)
47  !$omp declare target to(/block2/) device_type(host)
48  !$omp declare target to(/block3/) device_type(any)
49  !$omp declare target link(/block4/) device_type(nohost)
50  !$omp declare target link(/block5/) device_type(host)
51  !$omp declare target link(/block6/) device_type(any)
52contains
53  subroutine s1
54    !$omp declare target to (s1) device_type (any)
55  end
56  subroutine s2
57    !$omp declare target to (s2) device_type (nohost)
58  end
59  subroutine s3
60    !$omp declare target to (s3) device_type (host)
61  end
62end module
63
64module m2
65  use mymod
66  implicit none
67  public
68  private :: s1, s2, s3, a, b, c, d, e, f, g
69  public :: m, n, o, p, q, r, s, t, u, v, w, x
70end module m2
71
72! { dg-final { scan-tree-dump-times "omp declare target" 7 "original" } }
73! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(" 7 "original" } }
74! { dg-final { scan-tree-dump-not "__attribute__\\(\\(omp declare target \[^\n\r\]*\[\n\r\]void f1" "original" } }
75! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]__attribute__\[^\n\r]+\[\n\r]void f2" 1 "original" } }
76! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]__attribute__\[^\n\r]+\[\n\r\]void f3" 1 "original" } }
77! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(host\\)\\)\\)\\)\[\n\r]__attribute__\[^\n\r]+\[\n\r\]void f4" 1 "original" } }
78! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(nohost\\)\\)\\)\\)\[\n\r]__attribute__\[^\n\r]+\[\n\r\]void f5" 1 "original" } }
79! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]__attribute__\[^\n\r]+\[\n\r\]void s1" 1 "original" } }
80! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(nohost\\)\\)\\)\\)\[\n\r]__attribute__\[^\n\r]+\[\n\r\]void s2" 1 "original" } }
81! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(host\\)\\)\\)\\)\[\n\r]__attribute__\[^\n\r]+\[\n\r\]void s3" 1 "original" } }
82