1! { dg-do compile }
2!
3! PR/fortran 25829
4!
5! Check parsing and checking of ASYNCHRONOUS
6!
7type(t) function func0()
8  asynchronous :: a
9  integer, asynchronous:: b
10  allocatable :: c
11  volatile :: d
12  type t
13    sequence
14    integer :: i = 5
15  end type t
16end function func0
17
18integer function func()
19  asynchronous :: func
20  integer, asynchronous:: b
21  allocatable :: c
22  volatile :: func
23  type t
24    sequence
25    integer :: i = 5
26  end type t
27end function func
28
29function func2() result(res)
30  volatile res
31  asynchronous res
32end function func2
33
34subroutine sub()
35  asynchronous sub ! { dg-error "SUBROUTINE attribute conflicts with ASYNCHRONOUS" }
36  volatile sub     ! { dg-error "SUBROUTINE attribute conflicts with VOLATILE" }
37end subroutine sub
38
39program main
40  asynchronous main ! { dg-error "PROGRAM attribute conflicts with ASYNCHRONOUS" }
41  volatile main     ! { dg-error "PROGRAM attribute conflicts with VOLATILE" }
42end program main
43