flang/test/Semantics/doconcurrent01.f90

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