public:
DoConcurrentEnforcement(parser::Messages &messages) : messages_{messages} {}
std::set<parser::Label> labels() { return labels_; }
+ std::set<parser::CharBlock> names() { return names_; }
template<typename T> bool Pre(const T &) { return true; }
template<typename T> void Post(const T &) {}
template<typename T> bool Pre(const parser::Statement<T> &statement) {
}
return true;
}
+ // C1167
+ bool Pre(const parser::WhereConstructStmt &s) {
+ addName(std::get<std::optional<parser::Name>>(s.t));
+ return true;
+ }
+ bool Pre(const parser::ForallConstructStmt &s) {
+ addName(std::get<std::optional<parser::Name>>(s.t));
+ return true;
+ }
+ bool Pre(const parser::ChangeTeamStmt &s) {
+ addName(std::get<std::optional<parser::Name>>(s.t));
+ return true;
+ }
+ bool Pre(const parser::CriticalStmt &s) {
+ addName(std::get<std::optional<parser::Name>>(s.t));
+ return true;
+ }
+ bool Pre(const parser::LabelDoStmt &s) {
+ addName(std::get<std::optional<parser::Name>>(s.t));
+ return true;
+ }
+ bool Pre(const parser::NonLabelDoStmt &s) {
+ addName(std::get<std::optional<parser::Name>>(s.t));
+ return true;
+ }
+ bool Pre(const parser::IfThenStmt &s) {
+ addName(std::get<std::optional<parser::Name>>(s.t));
+ return true;
+ }
+ bool Pre(const parser::SelectCaseStmt &s) {
+ addName(std::get<std::optional<parser::Name>>(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_,
}
return false;
}
+ void addName(const std::optional<parser::Name> &nm) {
+ if (nm.has_value()) {
+ names_.insert(nm.value().source);
+ }
+ }
+ std::set<parser::CharBlock> names_;
std::set<parser::Label> labels_;
parser::CharBlock currentStatementSourcePosition_;
parser::Messages &messages_;
class DoConcurrentLabelEnforce {
public:
- DoConcurrentLabelEnforce(
- parser::Messages &messages, std::set<parser::Label> &&labels)
- : messages_{messages}, labels_{labels} {}
+ DoConcurrentLabelEnforce(parser::Messages &messages,
+ std::set<parser::Label> &&labels, std::set<parser::CharBlock> &&names,
+ parser::CharBlock doConcurrentSourcePosition)
+ : messages_{messages}, labels_{labels}, names_{names},
+ doConcurrentSourcePosition_{doConcurrentSourcePosition} {}
template<typename T> bool Pre(const T &) { return true; }
template<typename T> bool Pre(const parser::Statement<T> &statement) {
currentStatementSourcePosition_ = statement.source;
return true;
}
+ bool Pre(const parser::DoConstruct &) {
+ ++do_depth_;
+ return true;
+ }
template<typename T> 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<std::list<parser::Label>>(computedGotoStmt.t)) {
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<parser::Name> &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_,
private:
parser::Messages &messages_;
std::set<parser::Label> labels_;
+ std::set<parser::CharBlock> names_;
+ int do_depth_{0};
parser::CharBlock currentStatementSourcePosition_{nullptr};
+ parser::CharBlock doConcurrentSourcePosition_{nullptr};
};
using CS = std::vector<const Symbol *>;
DoConcurrentEnforcement doConcurrentEnforcement{messages_};
parser::Walk(
std::get<parser::Block>(doConstruct.t), doConcurrentEnforcement);
- DoConcurrentLabelEnforce doConcurrentLabelEnforce{
- messages_, doConcurrentEnforcement.labels()};
+ DoConcurrentLabelEnforce doConcurrentLabelEnforce{messages_,
+ doConcurrentEnforcement.labels(), doConcurrentEnforcement.names(),
+ currentStatementSourcePosition_};
parser::Walk(
std::get<parser::Block>(doConstruct.t), doConcurrentLabelEnforce);
EnforceConcurrentLoopControl(*concurrent);
--- /dev/null
+! 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
--- /dev/null
+! 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
--- /dev/null
+! 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
projects / platform / upstream / llvm.git / commitdiff