[flang] Tests for DO loop semantics

These are tests for checks that are already implemented, but for which we
did not have tests.

Original-commit: flang-compiler/f18@68f5acf7b1202162150162e1974fe43341a33eed
Reviewed-on: https://github.com/flang-compiler/f18/pull/637
Tree-same-pre-rewrite: false

diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt
index 42b3ff6..f79286f 100644 (file)
--- a/flang/test/semantics/CMakeLists.txt
+++ b/flang/test/semantics/CMakeLists.txt
@@ -134,11 +134,15 @@ set(ERROR_TESTS
   allocate11.f90
   allocate12.f90
   allocate13.f90
+  doconcurrent01.f90
   dosemantics01.f90
   dosemantics02.f90
   dosemantics03.f90
   dosemantics04.f90
   dosemantics05.f90
+  dosemantics06.f90
+  dosemantics07.f90
+  dosemantics08.f90
   expr-errors01.f90
   null01.f90
   omp-clause-validity01.f90
@@ -214,7 +218,13 @@ set(LABEL_TESTS
 )
 
 set(DOCONCURRENT_TESTS
-  doconcurrent*.[Ff]90
+  doconcurrent02.f90
+  doconcurrent03.f90
+  doconcurrent04.f90
+  doconcurrent05.f90
+  doconcurrent06.f90
+  doconcurrent07.f90
+  doconcurrent08.f90
 )
 
 set(CANONDO_TESTS

diff --git a/flang/test/semantics/doconcurrent01.f90 b/flang/test/semantics/doconcurrent01.f90
index 5ae5f8f..4d76251 100644 (file)
--- a/flang/test/semantics/doconcurrent01.f90
+++ b/flang/test/semantics/doconcurrent01.f90
@@ -11,21 +11,34 @@
 ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 ! See the License for the specific language governing permissions and
 ! limitations under the License.
-
-! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
-! CHECK: image control statement not allowed in DO CONCURRENT
-! CHECK: RETURN not allowed in DO CONCURRENT
-! CHECK: call to impure subroutine in DO CONCURRENT not allowed
-! CHECK: IEEE_GET_FLAG not allowed in DO CONCURRENT
-! CHECK: ADVANCE specifier not allowed in DO CONCURRENT
-! CHECK: SYNC ALL
-! CHECK: SYNC IMAGES
+!
+! C1141
+! A reference to the procedure IEEE_GET_FLAG, IEEE_SET_HALTING_MODE, or
+! IEEE_GET_- 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
 
 module ieee_exceptions
   interface
      subroutine ieee_get_flag(i, j)
        integer :: i, j
      end subroutine ieee_get_flag
+     subroutine ieee_get_halting_mode(i, j)
+       integer :: i
+       logical :: j
+     end subroutine ieee_get_halting_mode
+     subroutine ieee_set_halting_mode(i, j)
+       integer :: i
+       logical :: j
+     end subroutine ieee_set_halting_mode
   end interface
 end module ieee_exceptions
 
@@ -38,8 +51,11 @@ subroutine do_concurrent_test1(i,n)
   implicit none
   integer :: i, n
   do 10 concurrent (i = 1:n)
+!ERROR: image control statement not allowed in DO CONCURRENT
      SYNC ALL
+!ERROR: image control statement not allowed in DO CONCURRENT
      SYNC IMAGES (*)
+!ERROR: RETURN not allowed in DO CONCURRENT
      return
 10 continue
 end subroutine do_concurrent_test1
@@ -49,11 +65,22 @@ subroutine do_concurrent_test2(i,j,n,flag)
   use iso_fortran_env, only: team_type
   implicit none
   integer :: i, n, flag, flag2
+  logical :: halting
   type(team_type) :: j
   do concurrent (i = 1:n)
     change team (j)
+!ERROR: call to impure subroutine in DO CONCURRENT not allowed
+!ERROR: IEEE_GET_FLAG not allowed in DO CONCURRENT
       call ieee_get_flag(flag, flag2)
+!ERROR: call to impure subroutine in DO CONCURRENT not allowed
+!ERROR: IEEE_GET_HALTING_MODE not allowed in DO CONCURRENT
+      call ieee_get_halting_mode(flag, halting)
+!ERROR: call to impure subroutine in DO CONCURRENT not allowed
+!ERROR: IEEE_SET_HALTING_MODE not allowed in DO CONCURRENT
+      call ieee_set_halting_mode(flag, halting)
+!ERROR: image control statement not allowed in DO CONCURRENT
     end team
+!ERROR: ADVANCE specifier not allowed in DO CONCURRENT
     write(*,'(a35)',advance='no')
   end do
 end subroutine do_concurrent_test2

diff --git a/flang/test/semantics/dosemantics06.f90 b/flang/test/semantics/dosemantics06.f90
new file mode 100644 (file)
index 0000000..2c6e159
--- /dev/null
+++ b/flang/test/semantics/dosemantics06.f90
@@ -0,0 +1,55 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! C1131, C1133 -- check valid and invalid DO loop naming
+! C1131 (R1119) If the do-stmt of a do-construct specifies a do-construct-name,
+! the corresponding end-do shall be an end-do-stmt specifying the same
+! do-construct-name. If the do-stmt of a do-construct does not specify a
+! do-construct-name, the corresponding end-do shall not specify a
+! do-construct-name.
+!
+! C1133 (R1119) If the do-stmt is a label-do-stmt, the corresponding end-do
+! shall be identified with the same label.
+
+subroutine s1()
+  implicit none
+  ! Valid construct
+  validdo: do while (.true.)
+      print *, "hello"
+      cycle validdo
+      print *, "Weird to get here"
+    end do validdo
+
+  validdo: do while (.true.)
+      print *, "Hello"
+    end do validdo
+
+  ! Missing name on initial DO
+  do while (.true.)
+      print *, "Hello"
+!ERROR: DO construct name unexpected
+    end do formerlabelmissing
+
+  dolabel: do while (.true.)
+      print *, "Hello"
+!ERROR: DO construct name mismatch
+    end do differentlabel
+
+  dowithcycle: do while (.true.)
+      print *, "Hello"
+!ERROR: CYCLE construct-name is not in scope
+      cycle validdo
+    end do dowithcycle
+
+end subroutine s1

diff --git a/flang/test/semantics/dosemantics07.f90 b/flang/test/semantics/dosemantics07.f90
new file mode 100644 (file)
index 0000000..093c761
--- /dev/null
+++ b/flang/test/semantics/dosemantics07.f90
@@ -0,0 +1,23 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+!C1132
+! If the do-stmt is a nonlabel-do-stmt, the corresponding end-do shall be an
+! end-do-stmt.
+subroutine s1()
+  do while (.true.)
+    print *, "Hello"
+  continue
+!ERROR: expected 'END DO'
+end subroutine s1

diff --git a/flang/test/semantics/dosemantics08.f90 b/flang/test/semantics/dosemantics08.f90
new file mode 100644 (file)
index 0000000..f9b04e4
--- /dev/null
+++ b/flang/test/semantics/dosemantics08.f90
@@ -0,0 +1,27 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! C1138 -- 
+! A branch (11.2) within a DO CONCURRENT construct shall not have a branch
+! target that is outside the construct.
+
+subroutine s1()
+  do concurrent (i=1:10)
+!ERROR: control flow escapes from DO CONCURRENT
+    goto 99
+  end do
+
+99 print *, "Hello"
+
+end subroutine s1