flang/test/Semantics/doconcurrent01.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! C1141
   3 ! A reference to the procedure IEEE_SET_HALTING_MODE ! from the intrinsic
   4 ! module IEEE_EXCEPTIONS, shall not ! appear within a DO CONCURRENT construct.
   5 !
   6 ! C1137
   7 ! An image control statement shall not appear within a DO CONCURRENT construct.
   8 !
   9 ! C1136
  10 ! A RETURN statement shall not appear within a DO CONCURRENT construct.
  11 !
  12 ! (11.1.7.5), paragraph 4
  13 ! In a DO CONCURRENT, can't have an i/o statement with an ADVANCE= specifier
  14
  15 subroutine do_concurrent_test1(i,n)
  16   implicit none
  17   integer :: i, n
  18   do 10 concurrent (i = 1:n)
  19 !ERROR: An image control statement is not allowed in DO CONCURRENT
  20      SYNC ALL
  21 !ERROR: An image control statement is not allowed in DO CONCURRENT
  22      SYNC IMAGES (*)
  23 !ERROR: An image control statement is not allowed in DO CONCURRENT
  24      SYNC MEMORY
  25 !ERROR: RETURN is not allowed in DO CONCURRENT
  26      return
  27 10 continue
  28 end subroutine do_concurrent_test1
  29
  30 subroutine do_concurrent_test2(i,j,n,flag)
  31   use ieee_exceptions
  32   use iso_fortran_env, only: team_type
  33   implicit none
  34   integer :: i, n
  35   type(ieee_flag_type) :: flag
  36   logical :: flagValue, halting
  37   type(team_type) :: j
  38   type(ieee_status_type) :: status
  39   do concurrent (i = 1:n)
  40 !ERROR: An image control statement is not allowed in DO CONCURRENT
  41     sync team (j)
  42 !ERROR: An image control statement is not allowed in DO CONCURRENT
  43     change team (j)
  44 !ERROR: An image control statement is not allowed in DO CONCURRENT
  45       critical
  46 !ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
  47         call ieee_get_status(status)
  48 !ERROR: IEEE_SET_HALTING_MODE is not allowed in DO CONCURRENT
  49         call ieee_set_halting_mode(flag, halting)
  50       end critical
  51     end team
  52 !ERROR: ADVANCE specifier is not allowed in DO CONCURRENT
  53     write(*,'(a35)',advance='no')
  54   end do
  55
  56 ! The following is OK
  57   do concurrent (i = 1:n)
  58         call ieee_set_flag(flag, flagValue)
  59   end do
  60 end subroutine do_concurrent_test2
  61
  62 subroutine s1()
  63   use iso_fortran_env
  64   type(event_type) :: x
  65   do concurrent (i = 1:n)
  66 !ERROR: An image control statement is not allowed in DO CONCURRENT
  67     event post (x)
  68   end do
  69 end subroutine s1
  70
  71 subroutine s2()
  72   use iso_fortran_env
  73   type(event_type) :: x
  74   do concurrent (i = 1:n)
  75 !ERROR: An image control statement is not allowed in DO CONCURRENT
  76     event wait (x)
  77   end do
  78 end subroutine s2
  79
  80 subroutine s3()
  81   use iso_fortran_env
  82   type(team_type) :: t
  83
  84   do concurrent (i = 1:n)
  85 !ERROR: An image control statement is not allowed in DO CONCURRENT
  86     form team(1, t)
  87   end do
  88 end subroutine s3
  89
  90 subroutine s4()
  91   use iso_fortran_env
  92   type(lock_type) :: l
  93
  94   do concurrent (i = 1:n)
  95 !ERROR: An image control statement is not allowed in DO CONCURRENT
  96     lock(l)
  97 !ERROR: An image control statement is not allowed in DO CONCURRENT
  98     unlock(l)
  99   end do
 100 end subroutine s4
 101
 102 subroutine s5()
 103   do concurrent (i = 1:n)
 104 !ERROR: An image control statement is not allowed in DO CONCURRENT
 105     stop
 106   end do
 107 end subroutine s5
 108
 109 subroutine s6()
 110   type :: type0
 111     integer, allocatable, dimension(:) :: type0_field
 112     integer, allocatable, dimension(:), codimension[:] :: coarray_type0_field
 113   end type
 114
 115   type :: type1
 116     type(type0) :: type1_field
 117   end type
 118
 119   type(type1) :: pvar;
 120   type(type1) :: qvar;
 121   integer, allocatable, dimension(:) :: array1
 122   integer, allocatable, dimension(:) :: array2
 123   integer, allocatable, codimension[:] :: ca, cb
 124   integer, allocatable :: aa, ab
 125
 126   ! All of the following are allowable outside a DO CONCURRENT
 127   allocate(array1(3), pvar%type1_field%type0_field(3), array2(9))
 128   allocate(pvar%type1_field%coarray_type0_field(3)[*])
 129   allocate(ca[*])
 130   allocate(ca[*], pvar%type1_field%coarray_type0_field(3)[*])
 131
 132   do concurrent (i = 1:10)
 133     allocate(pvar%type1_field%type0_field(3))
 134   end do
 135
 136   do concurrent (i = 1:10)
 137 !ERROR: An image control statement is not allowed in DO CONCURRENT
 138     allocate(ca[*])
 139   end do
 140
 141   do concurrent (i = 1:10)
 142 !ERROR: An image control statement is not allowed in DO CONCURRENT
 143     deallocate(ca)
 144   end do
 145
 146   do concurrent (i = 1:10)
 147 !ERROR: An image control statement is not allowed in DO CONCURRENT
 148     allocate(pvar%type1_field%coarray_type0_field(3)[*])
 149   end do
 150
 151   do concurrent (i = 1:10)
 152 !ERROR: An image control statement is not allowed in DO CONCURRENT
 153     deallocate(pvar%type1_field%coarray_type0_field)
 154   end do
 155
 156   do concurrent (i = 1:10)
 157 !ERROR: An image control statement is not allowed in DO CONCURRENT
 158     allocate(ca[*], pvar%type1_field%coarray_type0_field(3)[*])
 159   end do
 160
 161   do concurrent (i = 1:10)
 162 !ERROR: An image control statement is not allowed in DO CONCURRENT
 163     deallocate(ca, pvar%type1_field%coarray_type0_field)
 164   end do
 165
 166 ! Call to MOVE_ALLOC of a coarray outside a DO CONCURRENT.  This is OK.
 167   call move_alloc(ca, cb)
 168
 169 ! Call to MOVE_ALLOC with non-coarray arguments in a DO CONCURRENT.  This is OK.
 170   allocate(aa)
 171   do concurrent (i = 1:10)
 172     call move_alloc(aa, ab)
 173   end do
 174
 175   do concurrent (i = 1:10)
 176 !ERROR: An image control statement is not allowed in DO CONCURRENT
 177     call move_alloc(ca, cb)
 178   end do
 179
 180   do concurrent (i = 1:10)
 181 !ERROR: An image control statement is not allowed in DO CONCURRENT
 182     call move_alloc(pvar%type1_field%coarray_type0_field, qvar%type1_field%coarray_type0_field)
 183   end do
 184 end subroutine s6
 185
 186 subroutine s7()
 187   interface
 188     pure integer function pf()
 189     end function pf
 190   end interface
 191
 192   type :: procTypeNotPure
 193     procedure(notPureFunc), pointer, nopass :: notPureProcComponent
 194   end type procTypeNotPure
 195
 196   type :: procTypePure
 197     procedure(pf), pointer, nopass :: pureProcComponent
 198   end type procTypePure
 199
 200   type(procTypeNotPure) :: procVarNotPure
 201   type(procTypePure) :: procVarPure
 202   integer :: ivar
 203
 204   procVarPure%pureProcComponent => pureFunc
 205
 206   do concurrent (i = 1:10)
 207     print *, "hello"
 208   end do
 209
 210   do concurrent (i = 1:10)
 211     ivar = pureFunc()
 212   end do
 213
 214   ! This should not generate errors
 215   do concurrent (i = 1:10)
 216     ivar = procVarPure%pureProcComponent()
 217   end do
 218
 219   ! This should generate an error
 220   do concurrent (i = 1:10)
 221 !ERROR: Call to an impure procedure component is not allowed in DO CONCURRENT
 222     ivar = procVarNotPure%notPureProcComponent()
 223   end do
 224
 225   contains
 226     integer function notPureFunc()
 227       notPureFunc = 2
 228     end function notPureFunc
 229
 230     pure integer function pureFunc()
 231       pureFunc = 3
 232     end function pureFunc
 233
 234 end subroutine s7