summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/coarray_3.f90
blob: 63c3bd33571b67e08da078b199887ad7db4c189f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
! { dg-do compile }
! { dg-options "-fcoarray=single" }
! 
! Coarray support
! PR fortran/18918

implicit none
integer :: n, m(1), k
character(len=30) :: str(2)

critical fkl ! { dg-error "Syntax error in CRITICAL" }
end critical fkl ! { dg-error "Expecting END PROGRAM" }

sync all (stat=1) ! { dg-error "Syntax error in SYNC ALL" }
sync all ( stat = n,stat=k) ! { dg-error "Redundant STAT" }
sync memory (errmsg=str)
sync memory (errmsg=n) ! { dg-error "must be a scalar CHARACTER variable" }
sync images (*, stat=1.0) ! { dg-error "Syntax error in SYNC IMAGES" }
sync images (-1) ! { dg-error "must between 1 and num_images" }
sync images (1)
sync images ( [ 1 ])
sync images ( m(1:0) ) 
sync images ( reshape([1],[1,1])) ! { dg-error "must be a scalar or rank-1" }
end

subroutine foo
critical
  stop 'error' ! { dg-error "Image control statement STOP" }
  sync all     ! { dg-error "Image control statement SYNC" }
  return 1     ! { dg-error "Image control statement RETURN" }
  critical     ! { dg-error "Nested CRITICAL block" }
  end critical 
end critical   ! { dg-error "Expecting END SUBROUTINE" }
end

subroutine bar()
do
  critical
    cycle ! { dg-error "leaves CRITICAL construct" }
  end critical
end do

outer: do
  critical
    do
      exit
      exit outer ! { dg-error "leaves CRITICAL construct" }
    end do
  end critical
end do outer
end subroutine bar


subroutine sub()
333 continue ! { dg-error "leaves CRITICAL construct" }
do
  critical
    if (.false.) then
      goto 333 ! { dg-error "leaves CRITICAL construct" }
      goto 777
777 end if
  end critical
end do

if (.true.) then
outer: do
  critical
    do
      goto 444
      goto 555 ! { dg-error "leaves CRITICAL construct" }
    end do
444 continue
  end critical
 end do outer
555 end if ! { dg-error "leaves CRITICAL construct" }
end subroutine sub

pure subroutine pureSub()
  critical ! { dg-error "Image control statement CRITICAL" }
  end critical ! { dg-error "Expecting END SUBROUTINE statement" }
  sync all ! { dg-error "Image control statement SYNC" }
  error stop ! { dg-error "not allowed in PURE procedure" }
end subroutine pureSub


SUBROUTINE TEST
   goto 10 ! { dg-warning "is not in the same block" }
   CRITICAL
     goto 5  ! OK
5    continue ! { dg-warning "is not in the same block" }
     goto 10 ! OK
     goto 20 ! { dg-error "leaves CRITICAL construct" }
     goto 30 ! { dg-error "leaves CRITICAL construct" }
10 END CRITICAL ! { dg-warning "is not in the same block" }
   goto 5 ! { dg-warning "is not in the same block" }
20 continue ! { dg-error "leaves CRITICAL construct" }
   BLOCK
30   continue ! { dg-error "leaves CRITICAL construct" }
   END BLOCK
end SUBROUTINE TEST