Mercurial > hg > CbC > CbC_llvm
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