101 lines
2.6 KiB
Fortran
101 lines
2.6 KiB
Fortran
! { 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
|