flang/test/Semantics/doconcurrent05.f90

   1 ! RUN: %S/test_errors.sh %s %t %flang_fc1
   2 ! REQUIRES: shell
   3 ! C1167 -- An exit-stmt shall not appear within a DO CONCURRENT construct if
   4 ! it belongs to that construct or an outer construct.
   5
   6 subroutine do_concurrent_test1(n)
   7   implicit none
   8   integer :: n
   9   integer :: j,k
  10   mydoc: do concurrent(j=1:n)
  11   mydo:    do k=1,n
  12 !ERROR: EXIT must not leave a DO CONCURRENT statement
  13              if (k==5) exit mydoc
  14              if (j==10) exit mydo
  15            end do mydo
  16          end do mydoc
  17 end subroutine do_concurrent_test1
  18
  19 subroutine do_concurrent_test2(n)
  20   implicit none
  21   integer :: j,k,n
  22   mydoc: do concurrent(j=1:n)
  23 !ERROR: EXIT must not leave a DO CONCURRENT statement
  24            if (k==5) exit
  25          end do mydoc
  26 end subroutine do_concurrent_test2
  27
  28 subroutine do_concurrent_test3(n)
  29   implicit none
  30   integer :: j,k,n
  31   mytest3: if (n>0) then
  32   mydoc:    do concurrent(j=1:n)
  33               do k=1,n
  34 !ERROR: EXIT must not leave a DO CONCURRENT statement
  35                 if (j==10) exit mytest3
  36               end do
  37             end do mydoc
  38           end if mytest3
  39 end subroutine do_concurrent_test3
  40
  41 subroutine do_concurrent_test4(n)
  42   implicit none
  43   integer :: j,k,n
  44   mytest4: if (n>0) then
  45   mydoc:    do concurrent(j=1:n)
  46               do concurrent(k=1:n)
  47 !ERROR: EXIT must not leave a DO CONCURRENT statement
  48                 if (k==5) exit
  49 !ERROR: EXIT must not leave a DO CONCURRENT statement
  50 !ERROR: EXIT must not leave a DO CONCURRENT statement
  51                 if (j==10) exit mytest4
  52               end do
  53             end do mydoc
  54           end if mytest4
  55 end subroutine do_concurrent_test4