xref: /llvm-project/flang/test/Semantics/cuf09.cuf (revision 3d59e30cbcfea475594aaf1c69388c0503f846ef)
1! RUN: %python %S/test_errors.py %s %flang_fc1
2module m
3 integer :: m(100)
4 integer, constant :: c(10)
5 integer, parameter :: p(5) = [1,2,3,4,5]
6 contains
7  attributes(device) subroutine devsub
8    !ERROR: Statement may not appear in device code
9    !$cuf kernel do <<< 1, 2 >>>
10    do k=1,10
11    end do
12  end
13  attributes(device) subroutine devsub2
14    real, device :: x(10)
15    print*,'from device'
16    print '(f10.5)', (x(ivar), ivar = 1, 10)
17    write(*,*), "Hello world from device!"
18    !WARNING: I/O statement might not be supported on device
19    write(12,'(10F4.1)'), x
20  end
21  attributes(global) subroutine hostglobal(a)
22    integer :: a(*)
23    i = threadIdx%x
24    !ERROR: Host array 'm' cannot be present in device context
25    if (i .le. N) a(i) = m(i)
26  end subroutine
27
28  attributes(global) subroutine hostparameter(a)
29    integer :: a(*)
30    i = threadIdx%x
31    if (i .le. N) a(i) = p(i) ! ok. p is parameter
32  end subroutine
33
34  attributes(global) subroutine localarray()
35    integer :: a(10)
36    i = threadIdx%x
37    a(i) = i
38  end subroutine
39
40  attributes(global) subroutine sharedarray(a)
41    integer, device :: a(10)
42    integer, shared :: s(10)
43    i = threadIdx%x
44    a(i) = s(10) ! ok, a is device and s is shared
45  end subroutine
46
47  attributes(global) subroutine cstarray(a)
48    integer, device :: a(10)
49    i = threadIdx%x
50    a(i) = c(10) ! ok, a is device and c is constant
51  end subroutine
52
53  attributes(global) subroutine stoptest()
54    print*,threadIdx%x
55    stop ! ok
56  end subroutine
57
58  attributes(global) subroutine cycletest()
59    integer :: i
60    do i = 1, 10
61      cycle ! ok
62    end do
63  end subroutine
64
65  attributes(global) subroutine gototest()
66    integer :: i
67    goto 10
68    10 print *, "X is negative!"
69  end subroutine
70
71  attributes(global) subroutine exittest()
72    integer :: i
73    do i = 1, 10
74      if (i == 1) then
75        exit ! ok
76      end if
77    end do
78  end subroutine
79
80  attributes(global) subroutine selectcasetest()
81    integer :: i
82    select case(i)
83    case (1)
84      print*,'main'
85    case default
86      print*, 'default'
87    end select
88  end subroutine
89
90  subroutine host()
91    integer :: i
92    !$cuf kernel do
93    do i = 1, 10
94      !ERROR: Statement may not appear in cuf kernel code
95      cycle
96    end do
97
98    !$cuf kernel do
99    do i = 1, 10
100      if (i == 1) then
101        !ERROR: Statement may not appear in cuf kernel code
102        exit ! ok
103      end if
104
105      !ERROR: Statement may not appear in cuf kernel code
106      goto 10
107      10 print *, "X is negative!"
108    end do
109  end subroutine
110end
111
112program main
113  integer, device :: a_d(10 ,10)
114  integer :: b(10, 10)
115  !$cuf kernel do <<< *, * >>> ! ok
116  do j = 1, 0
117  end do
118  !$cuf kernel do <<< (*), (*) >>> ! ok
119  do j = 1, 0
120  end do
121  !$cuf kernel do <<< (1,*), (2,*) >>> ! ok
122  do j = 1, 0
123  end do
124  !ERROR: !$CUF KERNEL DO (1) must be followed by a DO construct with tightly nested outer levels of counted DO loops
125  !$cuf kernel do <<< 1, 2 >>>
126  do while (.false.)
127  end do
128  !ERROR: !$CUF KERNEL DO (1) must be followed by a DO construct with tightly nested outer levels of counted DO loops
129  !$cuf kernel do <<< 1, 2 >>>
130  do
131    exit
132  end do
133  !$cuf kernel do <<< 1, 2 >>>
134  do concurrent (j=1:10)
135  end do
136  !$cuf kernel do <<< 1, 2 >>>
137  do 1 j=1,10
1381 continue ! ok
139  !$cuf kernel do <<< 1, 2 >>>
140  do j=1,10
141  end do ! ok
142  !$cuf kernel do <<< 1, 2 >>>
143  do j=1,10
144    !ERROR: Statement may not appear in device code
145    !$cuf kernel do <<< 1, 2 >>>
146    do k=1,10
147    end do
148  end do
149  !ERROR: !$CUF KERNEL DO (-1): loop nesting depth must be positive
150  !$cuf kernel do (-1) <<< 1, 2 >>>
151  do j=1,10
152  end do
153  !ERROR: !$CUF KERNEL DO (1) must be followed by a DO construct with tightly nested outer levels of counted DO loops
154  !$cuf kernel do <<< 1, 2 >>>
155  continue
156  !ERROR: !$CUF KERNEL DO (2) must be followed by a DO construct with tightly nested outer levels of counted DO loops
157  !$cuf kernel do (2) <<< 1, 2 >>>
158  do j=1,10
159  end do
160  !ERROR: !$CUF KERNEL DO (2) must be followed by a DO construct with tightly nested outer levels of counted DO loops
161  !$cuf kernel do (2) <<< 1, 2 >>>
162  do j=1,10
163    continue
164  end do
165  !ERROR: !$CUF KERNEL DO (2) must be followed by a DO construct with tightly nested outer levels of counted DO loops
166  !$cuf kernel do (2) <<< 1, 2 >>>
167  do j=1,10
168    do k=1,10
169    end do
170    continue
171  end do
172  !$cuf kernel do <<< 1, 2 >>>
173  do j = 1, 10
174    !ERROR: 'foo' may not be called in device code
175    call foo
176    !ERROR: 'bar' may not be called in device code
177    x = bar()
178    !ERROR: 'ifunc' may not be called in device code
179    if (ifunc() /= 0) continue
180    !ERROR: 'ifunc' may not be called in device code
181    if (ifunc() /= 0) then
182    !ERROR: 'ifunc' may not be called in device code
183    else if (ifunc() /= 1) then
184    end if
185  end do
186
187  !$cuf kernel do (2) <<<*, *>>>
188  do j = 1, 10
189     do i = 1, 10
190        !ERROR: Host array 'b' cannot be present in device context
191        a_d(i,j) = b(i,j)
192     enddo
193  enddo
194end
195