From: Peter Steinfeld Date: Thu, 8 Aug 2019 20:28:50 +0000 (-0700) Subject: [flang] Tests for DO loop semantics X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=5bade83a0b90f21b69019700c1992c932c8247a9;p=platform%2Fupstream%2Fllvm.git [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 --- 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 --- 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 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 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 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