OSDN Git Service

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