OSDN Git Service

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