1! { dg-do compile }
2! { dg-options "-fcoarray=single" }
3!
4! Coarray support
5! PR fortran/18918
6
7implicit none
8integer :: n, m(1), k
9character(len=30) :: str(2)
10
11critical fkl ! { dg-error "Syntax error in CRITICAL" }
12end critical fkl ! { dg-error "Expecting END PROGRAM" }
13
14sync all (stat=1) ! { dg-error "Syntax error in SYNC ALL" }
15sync all ( stat = n,stat=k) ! { dg-error "Redundant STAT" }
16sync memory (errmsg=str)
17sync memory (errmsg=n) ! { dg-error "must be a scalar CHARACTER variable" }
18sync images (*, stat=1.0) ! { dg-error "Syntax error in SYNC IMAGES" }
19sync images (-1) ! { dg-error "must between 1 and num_images" }
20sync images (1)
21sync images ( [ 1 ])
22sync images ( m(1:0) )
23sync images ( reshape([1],[1,1])) ! { dg-error "must be a scalar or rank-1" }
24end
25
26subroutine foo
27critical
28  stop 'error' ! { dg-error "Image control statement STOP" }
29  sync all     ! { dg-error "Image control statement SYNC" }
30  return 1     ! { dg-error "Image control statement RETURN" }
31  critical     ! { dg-error "Nested CRITICAL block" }
32  end critical
33end critical   ! { dg-error "Expecting END SUBROUTINE" }
34end
35
36subroutine bar()
37do
38  critical
39    cycle ! { dg-error "leaves CRITICAL construct" }
40  end critical
41end do
42
43outer: do
44  critical
45    do
46      exit
47      exit outer ! { dg-error "leaves CRITICAL construct" }
48    end do
49  end critical
50end do outer
51end subroutine bar
52
53
54subroutine sub()
55333 continue ! { dg-error "leaves CRITICAL construct" }
56do
57  critical
58    if (.false.) then
59      goto 333 ! { dg-error "leaves CRITICAL construct" }
60      goto 777
61777 end if
62  end critical
63end do
64
65if (.true.) then
66outer: do
67  critical
68    do
69      goto 444
70      goto 555 ! { dg-error "leaves CRITICAL construct" }
71    end do
72444 continue
73  end critical
74 end do outer
75555 end if ! { dg-error "leaves CRITICAL construct" }
76end subroutine sub
77
78pure subroutine pureSub()
79  critical ! { dg-error "Image control statement CRITICAL" }
80  end critical ! { dg-error "Expecting END SUBROUTINE statement" }
81  sync all ! { dg-error "Image control statement SYNC" }
82  error stop
83end subroutine pureSub
84
85
86SUBROUTINE TEST
87   goto 10 ! { dg-warning "is not in the same block" }
88   CRITICAL
89     goto 5  ! OK
905    continue ! { dg-warning "is not in the same block" }
91     goto 10 ! OK
92     goto 20 ! { dg-error "leaves CRITICAL construct" }
93     goto 30 ! { dg-error "leaves CRITICAL construct" }
9410 END CRITICAL ! { dg-warning "is not in the same block" }
95   goto 5 ! { dg-warning "is not in the same block" }
9620 continue ! { dg-error "leaves CRITICAL construct" }
97   BLOCK
9830   continue ! { dg-error "leaves CRITICAL construct" }
99   END BLOCK
100end SUBROUTINE TEST
101