From ee6c37e9ba2f69afeb00abf580be97891200fe21 Mon Sep 17 00:00:00 2001 From: Kiran Chandramohan Date: Tue, 19 Mar 2019 18:15:36 +0000 Subject: [PATCH] [flang] C1167 : Check for exit statments in do-concurrent Addresses https://github.com/flang-compiler/f18/issues/288 Original-commit: flang-compiler/f18@2a99e1ea5404fce9fd88ea2c9710ec4c01975eb6 Reviewed-on: https://github.com/flang-compiler/f18/pull/345 --- flang/lib/semantics/check-do-concurrent.cc | 86 ++++++++++++++++++++-- flang/test/semantics/doconcurrent05.f90 | 66 +++++++++++++++++ flang/test/semantics/doconcurrent06.f90 | 82 +++++++++++++++++++++ flang/test/semantics/doconcurrent07.f90 | 56 ++++++++++++++ 4 files changed, 285 insertions(+), 5 deletions(-) create mode 100644 flang/test/semantics/doconcurrent05.f90 create mode 100644 flang/test/semantics/doconcurrent06.f90 create mode 100644 flang/test/semantics/doconcurrent07.f90 diff --git a/flang/lib/semantics/check-do-concurrent.cc b/flang/lib/semantics/check-do-concurrent.cc index 351de30c4e73..a6995039e8b0 100644 --- a/flang/lib/semantics/check-do-concurrent.cc +++ b/flang/lib/semantics/check-do-concurrent.cc @@ -40,6 +40,7 @@ class DoConcurrentEnforcement { public: DoConcurrentEnforcement(parser::Messages &messages) : messages_{messages} {} std::set labels() { return labels_; } + std::set names() { return names_; } template bool Pre(const T &) { return true; } template void Post(const T &) {} template bool Pre(const parser::Statement &statement) { @@ -49,6 +50,47 @@ class DoConcurrentEnforcement { } return true; } + // C1167 + bool Pre(const parser::WhereConstructStmt &s) { + addName(std::get>(s.t)); + return true; + } + bool Pre(const parser::ForallConstructStmt &s) { + addName(std::get>(s.t)); + return true; + } + bool Pre(const parser::ChangeTeamStmt &s) { + addName(std::get>(s.t)); + return true; + } + bool Pre(const parser::CriticalStmt &s) { + addName(std::get>(s.t)); + return true; + } + bool Pre(const parser::LabelDoStmt &s) { + addName(std::get>(s.t)); + return true; + } + bool Pre(const parser::NonLabelDoStmt &s) { + addName(std::get>(s.t)); + return true; + } + bool Pre(const parser::IfThenStmt &s) { + addName(std::get>(s.t)); + return true; + } + bool Pre(const parser::SelectCaseStmt &s) { + addName(std::get>(s.t)); + return true; + } + bool Pre(const parser::SelectRankStmt &s) { + addName(std::get<0>(s.t)); + return true; + } + bool Pre(const parser::SelectTypeStmt &s) { + addName(std::get<0>(s.t)); + return true; + } // C1136 void Post(const parser::ReturnStmt &) { messages_.Say(currentStatementSourcePosition_, @@ -160,7 +202,13 @@ class DoConcurrentEnforcement { } return false; } + void addName(const std::optional &nm) { + if (nm.has_value()) { + names_.insert(nm.value().source); + } + } + std::set names_; std::set labels_; parser::CharBlock currentStatementSourcePosition_; parser::Messages &messages_; @@ -168,17 +216,24 @@ class DoConcurrentEnforcement { class DoConcurrentLabelEnforce { public: - DoConcurrentLabelEnforce( - parser::Messages &messages, std::set &&labels) - : messages_{messages}, labels_{labels} {} + DoConcurrentLabelEnforce(parser::Messages &messages, + std::set &&labels, std::set &&names, + parser::CharBlock doConcurrentSourcePosition) + : messages_{messages}, labels_{labels}, names_{names}, + doConcurrentSourcePosition_{doConcurrentSourcePosition} {} template bool Pre(const T &) { return true; } template bool Pre(const parser::Statement &statement) { currentStatementSourcePosition_ = statement.source; return true; } + bool Pre(const parser::DoConstruct &) { + ++do_depth_; + return true; + } template void Post(const T &) {} // C1138: branch from within a DO CONCURRENT shall not target outside loop + void Post(const parser::ExitStmt &exitStmt) { checkName(exitStmt.v); } void Post(const parser::GotoStmt &gotoStmt) { checkLabelUse(gotoStmt.v); } void Post(const parser::ComputedGotoStmt &computedGotoStmt) { for (auto &i : std::get>(computedGotoStmt.t)) { @@ -204,6 +259,23 @@ class DoConcurrentLabelEnforce { void Post(const parser::ErrLabel &errLabel) { checkLabelUse(errLabel.v); } void Post(const parser::EndLabel &endLabel) { checkLabelUse(endLabel.v); } void Post(const parser::EorLabel &eorLabel) { checkLabelUse(eorLabel.v); } + void Post(const parser::DoConstruct &) { --do_depth_; } + void checkName(const std::optional &nm) { + if (!nm.has_value()) { + if (do_depth_ == 0) { + messages_.Say(currentStatementSourcePosition_, + "exit from DO CONCURRENT construct (%s)"_err_en_US, + doConcurrentSourcePosition_.ToString().data()); + } + // nesting of named constructs is assumed to have been previously checked + // by the name/label resolution pass + } else if (names_.find(nm.value().source) == names_.end()) { + messages_.Say(currentStatementSourcePosition_, + "exit from DO CONCURRENT construct (%s) to construct with name '%s'"_err_en_US, + doConcurrentSourcePosition_.ToString().data(), + nm.value().source.ToString().data()); + } + } void checkLabelUse(const parser::Label &labelUsed) { if (labels_.find(labelUsed) == labels_.end()) { messages_.Say(currentStatementSourcePosition_, @@ -214,7 +286,10 @@ class DoConcurrentLabelEnforce { private: parser::Messages &messages_; std::set labels_; + std::set names_; + int do_depth_{0}; parser::CharBlock currentStatementSourcePosition_{nullptr}; + parser::CharBlock doConcurrentSourcePosition_{nullptr}; }; using CS = std::vector; @@ -339,8 +414,9 @@ class DoConcurrentContext { DoConcurrentEnforcement doConcurrentEnforcement{messages_}; parser::Walk( std::get(doConstruct.t), doConcurrentEnforcement); - DoConcurrentLabelEnforce doConcurrentLabelEnforce{ - messages_, doConcurrentEnforcement.labels()}; + DoConcurrentLabelEnforce doConcurrentLabelEnforce{messages_, + doConcurrentEnforcement.labels(), doConcurrentEnforcement.names(), + currentStatementSourcePosition_}; parser::Walk( std::get(doConstruct.t), doConcurrentLabelEnforce); EnforceConcurrentLoopControl(*concurrent); diff --git a/flang/test/semantics/doconcurrent05.f90 b/flang/test/semantics/doconcurrent05.f90 new file mode 100644 index 000000000000..4172aa7a4d0e --- /dev/null +++ b/flang/test/semantics/doconcurrent05.f90 @@ -0,0 +1,66 @@ +! Copyright (c) 2019, Arm Ltd. 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. + +! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s +! CHECK: exit from DO CONCURRENT construct \\(mydoc: do concurrent\\(j=1:n\\)\\) to construct with name 'mydoc' +! CHECK: exit from DO CONCURRENT construct \\(mydoc: do concurrent\\(j=1:n\\)\\) +! CHECK: exit from DO CONCURRENT construct \\(mydoc: do concurrent\\(j=1:n\\)\\) to construct with name 'mytest3' +! CHECK: exit from DO CONCURRENT construct \\(do concurrent\\(k=1:n\\)\\) +! CHECK: exit from DO CONCURRENT construct \\(do concurrent\\(k=1:n\\)\\) to construct with name 'mytest4' +! CHECK: exit from DO CONCURRENT construct \\(mydoc: do concurrent\\(j=1:n\\)\\) to construct with name 'mytest4' + +subroutine do_concurrent_test1(n) + implicit none + integer :: n + integer :: j,k + mydoc: do concurrent(j=1:n) + mydo: do k=1,n + if (k==5) exit mydoc + if (j==10) exit mydo + end do mydo + end do mydoc +end subroutine do_concurrent_test1 + +subroutine do_concurrent_test2(n) + implicit none + integer :: j,k,n + mydoc: do concurrent(j=1:n) + if (k==5) exit + end do mydoc +end subroutine do_concurrent_test2 + +subroutine do_concurrent_test3(n) + implicit none + integer :: j,k,n + mytest3: if (n>0) then + mydoc: do concurrent(j=1:n) + do k=1,n + if (j==10) exit mytest3 + end do + end do mydoc + end if mytest3 +end subroutine do_concurrent_test3 + +subroutine do_concurrent_test4(n) + implicit none + integer :: j,k,n + mytest4: if (n>0) then + mydoc: do concurrent(j=1:n) + do concurrent(k=1:n) + if (k==5) exit + if (j==10) exit mytest4 + end do + end do mydoc + end if mytest4 +end subroutine do_concurrent_test4 diff --git a/flang/test/semantics/doconcurrent06.f90 b/flang/test/semantics/doconcurrent06.f90 new file mode 100644 index 000000000000..866e61950ae9 --- /dev/null +++ b/flang/test/semantics/doconcurrent06.f90 @@ -0,0 +1,82 @@ +! Copyright (c) 2019, Arm Ltd. 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. + +! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s +! CHECK: exit from DO CONCURRENT construct \\(nc5: do concurrent\\(i5=1:n\\)\\) to construct with name 'mytest1' +! CHECK: exit from DO CONCURRENT construct \\(nc3: do concurrent\\(i3=1:n\\)\\) to construct with name 'mytest1' +! CHECK: exit from DO CONCURRENT construct \\(nc1: do concurrent\\(i1=1:n\\)\\) to construct with name 'mytest1' +! CHECK: exit from DO CONCURRENT construct \\(nc5: do concurrent\\(i5=1:n\\)\\) to construct with name 'nc3' +! CHECK: exit from DO CONCURRENT construct \\(nc3: do concurrent\\(i3=1:n\\)\\) to construct with name 'nc3' +! CHECK: exit from DO CONCURRENT construct \\(nc3: do concurrent\\(i3=1:n\\)\\) to construct with name 'nc2' + +subroutine do_concurrent_test1(n) + implicit none + integer :: i1,i2,i3,i4,i5,i6,n + mytest1: if (n>0) then + nc1: do concurrent(i1=1:n) + nc2: do i2=1,n + nc3: do concurrent(i3=1:n) + nc4: do i4=1,n + nc5: do concurrent(i5=1:n) + nc6: do i6=1,n + if (i6==10) exit mytest1 + end do nc6 + end do nc5 + end do nc4 + end do nc3 + end do nc2 + end do nc1 + end if mytest1 +end subroutine do_concurrent_test1 + +subroutine do_concurrent_test2(n) + implicit none + integer :: i1,i2,i3,i4,i5,i6,n + mytest2: if (n>0) then + nc1: do concurrent(i1=1:n) + nc2: do i2=1,n + nc3: do concurrent(i3=1:n) + nc4: do i4=1,n + nc5: do concurrent(i5=1:n) + nc6: do i6=1,n + if (i6==10) exit nc3 + end do nc6 + end do nc5 + end do nc4 + end do nc3 + end do nc2 + end do nc1 + end if mytest2 +end subroutine do_concurrent_test2 + +subroutine do_concurrent_test3(n) + implicit none + integer :: i1,i2,i3,i4,i5,i6,n + mytest3: if (n>0) then + nc1: do concurrent(i1=1:n) + nc2: do i2=1,n + nc3: do concurrent(i3=1:n) + if (i3==4) exit nc2 + nc4: do i4=1,n + nc5: do concurrent(i5=1:n) + nc6: do i6=1,n + if (i6==10) print *, "hello" + end do nc6 + end do nc5 + end do nc4 + end do nc3 + end do nc2 + end do nc1 + end if mytest3 +end subroutine do_concurrent_test3 diff --git a/flang/test/semantics/doconcurrent07.f90 b/flang/test/semantics/doconcurrent07.f90 new file mode 100644 index 000000000000..c4edd6314b00 --- /dev/null +++ b/flang/test/semantics/doconcurrent07.f90 @@ -0,0 +1,56 @@ +! Copyright (c) 2019, Arm Ltd. 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. + +! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s +! CHECK-NOT: exit from DO CONCURRENT construct + +subroutine do_concurrent_test1(n) + implicit none + integer :: j,k,l,n + mytest: if (n>0) then + mydoc: do concurrent(j=1:n) + mydo: do k=1,n + if (k==5) exit + if (k==6) exit mydo + end do mydo + do concurrent(l=1:n) + if (l==5) print *, "test" + end do + end do mydoc + do k=1,n + if (k==5) exit mytest + end do + end if mytest +end subroutine do_concurrent_test1 + +subroutine do_concurrent_test2(n) + implicit none + integer :: i1,i2,i3,i4,i5,i6,n + mytest2: if (n>0) then + nc1: do concurrent(i1=1:n) + nc2: do i2=1,n + nc3: do concurrent(i3=1:n) + nc4: do i4=1,n + if (i3==4) exit nc4 + nc5: do concurrent(i5=1:n) + nc6: do i6=1,n + if (i6==10) print *, "hello" + end do nc6 + end do nc5 + end do nc4 + end do nc3 + end do nc2 + end do nc1 + end if mytest2 +end subroutine do_concurrent_test2