forked from OSchip/llvm-project
243 lines
6.6 KiB
Fortran
243 lines
6.6 KiB
Fortran
! RUN: %S/test_errors.sh %s %t %f18
|
|
! C1141
|
|
! A reference to the procedure IEEE_SET_HALTING_MODE ! from the intrinsic
|
|
! module IEEE_EXCEPTIONS, shall not ! appear within a DO CONCURRENT construct.
|
|
!
|
|
! C1137
|
|
! An image control statement shall not appear within a DO CONCURRENT construct.
|
|
!
|
|
! C1136
|
|
! A RETURN statement shall not appear within a DO CONCURRENT construct.
|
|
!
|
|
! (11.1.7.5), paragraph 4
|
|
! In a DO CONCURRENT, can't have an i/o statement with an ADVANCE= specifier
|
|
|
|
subroutine do_concurrent_test1(i,n)
|
|
implicit none
|
|
integer :: i, n
|
|
do 10 concurrent (i = 1:n)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
SYNC ALL
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
SYNC IMAGES (*)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
SYNC MEMORY
|
|
!ERROR: RETURN is not allowed in DO CONCURRENT
|
|
return
|
|
10 continue
|
|
end subroutine do_concurrent_test1
|
|
|
|
subroutine do_concurrent_test2(i,j,n,flag)
|
|
use ieee_exceptions
|
|
use iso_fortran_env, only: team_type
|
|
implicit none
|
|
integer :: i, n
|
|
type(ieee_flag_type) :: flag
|
|
logical :: flagValue, halting
|
|
type(team_type) :: j
|
|
type(ieee_status_type) :: status
|
|
do concurrent (i = 1:n)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
sync team (j)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
change team (j)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
critical
|
|
!ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
|
|
call ieee_get_status(status)
|
|
!ERROR: IEEE_SET_HALTING_MODE is not allowed in DO CONCURRENT
|
|
call ieee_set_halting_mode(flag, halting)
|
|
end critical
|
|
end team
|
|
!ERROR: ADVANCE specifier is not allowed in DO CONCURRENT
|
|
write(*,'(a35)',advance='no')
|
|
end do
|
|
|
|
! The following is OK
|
|
do concurrent (i = 1:n)
|
|
call ieee_set_flag(flag, flagValue)
|
|
end do
|
|
end subroutine do_concurrent_test2
|
|
|
|
subroutine s1()
|
|
use iso_fortran_env
|
|
type(event_type) :: x
|
|
do concurrent (i = 1:n)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
event post (x)
|
|
end do
|
|
end subroutine s1
|
|
|
|
subroutine s2()
|
|
use iso_fortran_env
|
|
type(event_type) :: x
|
|
do concurrent (i = 1:n)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
event wait (x)
|
|
end do
|
|
end subroutine s2
|
|
|
|
subroutine s3()
|
|
use iso_fortran_env
|
|
type(team_type) :: t
|
|
|
|
do concurrent (i = 1:n)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
form team(1, t)
|
|
end do
|
|
end subroutine s3
|
|
|
|
subroutine s4()
|
|
use iso_fortran_env
|
|
type(lock_type) :: l
|
|
|
|
do concurrent (i = 1:n)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
lock(l)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
unlock(l)
|
|
end do
|
|
end subroutine s4
|
|
|
|
subroutine s5()
|
|
do concurrent (i = 1:n)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
stop
|
|
end do
|
|
end subroutine s5
|
|
|
|
subroutine s6()
|
|
type :: type0
|
|
integer, allocatable, dimension(:) :: type0_field
|
|
integer, allocatable, dimension(:), codimension[:] :: coarray_type0_field
|
|
end type
|
|
|
|
type :: type1
|
|
type(type0) :: type1_field
|
|
end type
|
|
|
|
type(type1) :: pvar;
|
|
type(type1) :: qvar;
|
|
integer, allocatable, dimension(:) :: array1
|
|
integer, allocatable, dimension(:) :: array2
|
|
integer, allocatable, codimension[:] :: ca, cb
|
|
integer, allocatable :: aa, ab
|
|
|
|
! All of the following are allowable outside a DO CONCURRENT
|
|
allocate(array1(3), pvar%type1_field%type0_field(3), array2(9))
|
|
allocate(pvar%type1_field%coarray_type0_field(3)[*])
|
|
allocate(ca[*])
|
|
allocate(ca[*], pvar%type1_field%coarray_type0_field(3)[*])
|
|
|
|
do concurrent (i = 1:10)
|
|
allocate(pvar%type1_field%type0_field(3))
|
|
end do
|
|
|
|
do concurrent (i = 1:10)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
allocate(ca[*])
|
|
end do
|
|
|
|
do concurrent (i = 1:10)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
deallocate(ca)
|
|
end do
|
|
|
|
do concurrent (i = 1:10)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
allocate(pvar%type1_field%coarray_type0_field(3)[*])
|
|
end do
|
|
|
|
do concurrent (i = 1:10)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
deallocate(pvar%type1_field%coarray_type0_field)
|
|
end do
|
|
|
|
do concurrent (i = 1:10)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
allocate(ca[*], pvar%type1_field%coarray_type0_field(3)[*])
|
|
end do
|
|
|
|
do concurrent (i = 1:10)
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
deallocate(ca, pvar%type1_field%coarray_type0_field)
|
|
end do
|
|
|
|
! Call to MOVE_ALLOC of a coarray outside a DO CONCURRENT. This is OK.
|
|
call move_alloc(ca, cb)
|
|
|
|
! Note that the errors below relating to MOVE_ALLOC() bing impure are bogus.
|
|
! They're the result of the fact that access to the move_alloc() instrinsic
|
|
! is not yet possible.
|
|
|
|
allocate(aa)
|
|
do concurrent (i = 1:10)
|
|
!ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
|
|
call move_alloc(aa, ab)
|
|
end do
|
|
|
|
! Call to MOVE_ALLOC with non-coarray arguments in a DO CONCURRENT. This is OK.
|
|
|
|
do concurrent (i = 1:10)
|
|
!ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
call move_alloc(ca, cb)
|
|
end do
|
|
|
|
do concurrent (i = 1:10)
|
|
!ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
|
|
!ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
call move_alloc(pvar%type1_field%coarray_type0_field, qvar%type1_field%coarray_type0_field)
|
|
end do
|
|
end subroutine s6
|
|
|
|
subroutine s7()
|
|
interface
|
|
pure integer function pf()
|
|
end function pf
|
|
end interface
|
|
|
|
type :: procTypeNotPure
|
|
procedure(notPureFunc), pointer, nopass :: notPureProcComponent
|
|
end type procTypeNotPure
|
|
|
|
type :: procTypePure
|
|
procedure(pf), pointer, nopass :: pureProcComponent
|
|
end type procTypePure
|
|
|
|
type(procTypeNotPure) :: procVarNotPure
|
|
type(procTypePure) :: procVarPure
|
|
integer :: ivar
|
|
|
|
procVarPure%pureProcComponent => pureFunc
|
|
|
|
do concurrent (i = 1:10)
|
|
print *, "hello"
|
|
end do
|
|
|
|
do concurrent (i = 1:10)
|
|
ivar = pureFunc()
|
|
end do
|
|
|
|
! This should not generate errors
|
|
do concurrent (i = 1:10)
|
|
ivar = procVarPure%pureProcComponent()
|
|
end do
|
|
|
|
! This should generate an error
|
|
do concurrent (i = 1:10)
|
|
!ERROR: Call to an impure procedure component is not allowed in DO CONCURRENT
|
|
ivar = procVarNotPure%notPureProcComponent()
|
|
end do
|
|
|
|
contains
|
|
integer function notPureFunc()
|
|
notPureFunc = 2
|
|
end function notPureFunc
|
|
|
|
pure integer function pureFunc()
|
|
pureFunc = 3
|
|
end function pureFunc
|
|
|
|
end subroutine s7
|