diff flang/test/Semantics/doconcurrent01.f90 @ 173:0572611fdcc8 llvm10 llvm12

reorgnization done
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 11:55:54 +0900
parents
children 2e18cbf3894f
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/flang/test/Semantics/doconcurrent01.f90	Mon May 25 11:55:54 2020 +0900
@@ -0,0 +1,242 @@
+! 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