diff --git a/flang/lib/Semantics/check-directive-structure.h b/flang/lib/Semantics/check-directive-structure.h --- a/flang/lib/Semantics/check-directive-structure.h +++ b/flang/lib/Semantics/check-directive-structure.h @@ -15,8 +15,8 @@ #include "flang/Common/enum-set.h" #include "flang/Semantics/semantics.h" #include "flang/Semantics/tools.h" +#include #include - namespace Fortran::semantics { template struct DirectiveClauses { @@ -34,11 +34,28 @@ NoBranchingEnforce(SemanticsContext &context, parser::CharBlock sourcePosition, D directive, std::string &&upperCaseDirName) - : context_{context}, sourcePosition_{sourcePosition}, + : numPrivateConstructs{0}, context_{context}, + sourcePosition_{sourcePosition}, upperCaseDirName_{std::move(upperCaseDirName)}, currentDirective_{ - directive} {} - template bool Pre(const T &) { return true; } - template void Post(const T &) {} + directive} { + privateConstructStackCopy = context_.constructStack(); + } + ~NoBranchingEnforce() { + assert(privateConstructStackCopy == context_.constructStack()); + } + template bool Pre(const T &node) { + if constexpr (common::HasMember) { + numPrivateConstructs++; + context_.PushConstruct(node); + } + return true; + } + template void Post(const T &) { + if constexpr (common::HasMember) { + numPrivateConstructs--; + context_.PopConstruct(); + } + } template bool Pre(const parser::Statement &statement) { currentStatementSourcePosition_ = statement.source; @@ -49,16 +66,33 @@ void Post(const parser::ExitStmt &exitStmt) { if (const auto &exitName{exitStmt.v}) { CheckConstructNameBranching("EXIT", exitName.value()); + } else { + CheckConstructNameBranching("EXIT"); } } void Post(const parser::StopStmt &) { EmitBranchOutError("STOP"); } void Post(const parser::CycleStmt &cycleStmt) { if (const auto &cycleName{cycleStmt.v}) { CheckConstructNameBranching("CYCLE", cycleName.value()); + } else { + switch ((llvm::omp::Directive)currentDirective_) { + // exclude directives which do not need a check for unlabelled CYCLES + case llvm::omp::Directive::OMPD_do: + return; + case llvm::omp::Directive::OMPD_simd: + return; + default: + break; + } + CheckConstructNameBranching("CYCLE"); } } private: + // tracks the number of constructs added to the ConstructStack AFTER + // encountering an OpenMP/OpenACC directive + unsigned int numPrivateConstructs; + ConstructStack privateConstructStackCopy; parser::MessageFormattedText GetEnclosingMsg() const { return {"Enclosing %s construct"_en_US, upperCaseDirName_}; } @@ -71,6 +105,14 @@ .Attach(sourcePosition_, GetEnclosingMsg()); } + void EmitUnlabelledBranchOutError(const char *stmt) { + context_ + .Say(currentStatementSourcePosition_, + "%s to construct outside of %s construct is not allowed"_err_en_US, + stmt, upperCaseDirName_) + .Attach(sourcePosition_, GetEnclosingMsg()); + } + void EmitBranchOutErrorWithName( const char *stmt, const parser::Name &toName) const { const std::string branchingToName{toName.ToString()}; @@ -90,10 +132,11 @@ void CheckConstructNameBranching( const char *stmt, const parser::Name &stmtName) { const ConstructStack &stack{context_.constructStack()}; + int16_t counter = numPrivateConstructs; for (auto iter{stack.cend()}; iter-- != stack.cbegin();) { const ConstructNode &construct{*iter}; const auto &constructName{MaybeGetNodeName(construct)}; - if (constructName) { + if (counter-- < 1 && constructName) { if (stmtName.source == constructName->source) { EmitBranchOutErrorWithName(stmt, stmtName); return; @@ -102,6 +145,31 @@ } } + bool CheckForRequiredConstruct(const ConstructNode &construct) const { + return std::visit(common::visitors{ + [&](const parser::DoConstruct *) { return true; }, + [](const auto *) { return false; }, + }, + construct); + } + // Check branching for unlabelled CYCLES and EXITs + void CheckConstructNameBranching(const char *stmt) { + // Check for associated ConstructNode within the OpenMP/OpenACC directive + const ConstructStack &stack{context_.constructStack()}; + int16_t counter = numPrivateConstructs; + for (auto iter{stack.cend()}; iter-- != stack.cbegin();) { + const ConstructNode &construct{*iter}; + // found an enclosing looping construct for the unlabelled EXIT/CYCLE + if (counter-- > 0 && CheckForRequiredConstruct(construct)) { + return; + } + } + // did not found an enclosing looping construct within the OpenMP/OpenACC + // directive + EmitUnlabelledBranchOutError(stmt); + return; + } + SemanticsContext &context_; parser::CharBlock currentStatementSourcePosition_; parser::CharBlock sourcePosition_; diff --git a/flang/test/Semantics/omp-sections02.f90 b/flang/test/Semantics/omp-sections02.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-sections02.f90 @@ -0,0 +1,139 @@ +! RUN: %S/test_errors.sh %s %t %flang -fopenmp +!REQUIRES: shell + +! OpenMP version 5.0.0 +! 2.8.1 sections construct +! The code enclosed in a sections construct must be a structured block. +program OmpConstructSections01 + use omp_lib + integer :: section_count = 0 + integer, parameter :: NT = 4 +print *, 'section_count', section_count +!ERROR: invalid branch into an OpenMP structured block +!ERROR: invalid branch into an OpenMP structured block +!ERROR: invalid branch into an OpenMP structured block +if(NT) 20, 30, 40 +!ERROR: invalid branch into an OpenMP structured block +goto 20 +!$omp sections + !$omp section + print*, "This is a single statement structured block" + !$omp section + open(10, file="random-file-name.txt",err=30) + !ERROR: invalid branch into an OpenMP structured block + !ERROR: invalid branch leaving an OpenMP structured block + open(10, file="random-file-name.txt", err=40) + !$omp section + section_count = section_count + 1 + 20 print*, 'Entering into section' + call calledFromWithinSection() + print *, 'section_count', section_count + !$omp section + section_count = section_count + 1 + print *, 'section_count', section_count + !ERROR: invalid branch leaving an OpenMP structured block + goto 10 + !$omp section + 30 print *, "Error in opening file" +!$omp end sections +10 print*, 'Jump from section' + +!$omp sections + !$omp section + 40 print*, 'Error in opening file' +!$omp end sections +end program OmpConstructSections01 + +function returnFromSections () + !$omp sections + !$omp section + !ERROR: RETURN statement is not allowed in a SECTIONS construct + RETURN + !$omp end sections +end function + +subroutine calledFromWithinSection() + print*, "I am called from within a 'section' structured block" + return +end subroutine calledFromWithinSection + +subroutine continueWithinSections() + integer i + do i = 1, 10 + print*, "Statement within loop but outside section construct" + !$omp sections + !$omp section + IF ( i .EQ. 5 ) THEN + !ERROR: CYCLE to construct outside of SECTIONS construct is not allowed + CYCLE + END IF + !$omp end sections + print*, "Statement within loop but outside section contruct" + end do + + !$omp sections + !$omp section + do i = 1, 10 + CYCLE + end do + !$omp end sections + + !$omp sections + !$omp section + loop_1: do i = 1, 10 + IF( i .EQ. 5 ) THEN + CYCLE loop_1 + END IF + end do loop_1 + !$omp end sections + + loop_2: do i = 1, 10 + !$omp sections + !$omp section + IF ( i .EQ. 5 ) THEN + !ERROR: CYCLE to construct 'loop_2' outside of SECTIONS construct is not allowed + CYCLE loop_2 + END IF + !$omp end sections + end do loop_2 +end subroutine continueWithinSections + +subroutine breakWithinSections() + loop_3: do i = 1, 10 + !$omp sections + !$omp section + IF (i .EQ. 5) THEN + !ERROR: EXIT to construct 'loop_3' outside of SECTIONS construct is not allowed + EXIT loop_3 + END IF + !$omp end sections + end do loop_3 + + loop_4: do i = 1, 10 + !$omp sections + !$omp section + IF (i .EQ. 5) THEN + !ERROR: EXIT to construct outside of SECTIONS construct is not allowed + EXIT + END IF + !$omp end sections + end do loop_4 + + !$omp sections + !$omp section + do i = 1, 10 + IF(i .EQ. 5) THEN + EXIT + END IF + end do + !$omp end sections + + !$omp sections + !$omp section + loop_5: do i = 1, 10 + IF(i .EQ. 5) THEN + EXIT loop_5 + END IF + end do loop_5 + !$omp end sections +end subroutine breakWithinSections diff --git a/flang/test/Semantics/omp-sections03.f90 b/flang/test/Semantics/omp-sections03.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-sections03.f90 @@ -0,0 +1,27 @@ +! RUN: %S/test_errors.sh %s %t %flang -fopenmp +!XFAIL: * +! OpenMP version 5.0.0 +! 2.8.1 sections construct +! Orphaned section directives are prohibited. That is, the section directives must appear within the sections construct and must not be encountered elsewhere in the sections region +!TODO: Error in parsing. Make parser errors more informative. Until then, the test is XFAIL + +program OmpOrphanedSections + use omp_lib + integer counter + counter = 0 + !CHECK: expected 'END' + !CHECK: END PROGRAM statement + !CHECK: in the context: main program + !CHECK: expected 'END PROGRAM' + !CHECK: in the context: END PROGRAM statement + !CHECK: in the context: main program + !$omp section + print*, "An orphaned section containing a single statement" + !$omp section + counter = counter + 1 + print*, "An orphaned section containing multiple statements" +!$omp sections + !$omp section + print*, "Not an orphan structured block" +!$omp end sections +end program OmpOrphanedSections diff --git a/flang/test/Semantics/omp-simd01.f90 b/flang/test/Semantics/omp-simd01.f90 --- a/flang/test/Semantics/omp-simd01.f90 +++ b/flang/test/Semantics/omp-simd01.f90 @@ -1,7 +1,10 @@ -! RUN: not %flang -fsyntax-only -fopenmp %s 2>&1 | FileCheck %s -! OpenMP Version 4.5 -! 2.8.1 simd Construct -! A program that branches into or out of a simd region is non-conforming. +! RUN: %S/test_errors.sh %s %t %flang -fopenmp +! REQUIRES: shell + +! OpenMP Version 5.0 +! 2.9.3.1 simd Construct +! - A program that branches into or out of a simd region is non-conforming. +! - The associated loops must be structured blocks program omp_simd integer i, j @@ -10,13 +13,30 @@ do i = 1, 10 do j = 1, 10 print *, "omp simd" - !CHECK: invalid branch leaving an OpenMP structured block + !ERROR: invalid branch leaving an OpenMP structured block goto 10 end do + if( i .EQ. 5 ) THEN + call function1() + else if ( i .EQ. 7 ) THEN + open(10, file="random-file-name.txt", err=20) + 20 print*, "Error message doesn't branch out of the loop's structured block" + else + !ERROR: invalid branch leaving an OpenMP structured block + open(10, file="random-file-name.txt", err=10) + end if end do !$omp end simd - - !CHECK: Outside the enclosing SIMD directive 10 stop end program omp_simd + +subroutine function1() + integer i, option + option = 1 + !$omp simd + do i = 1, 10 + print*, "CORRECT SIMD LOOP" + end do + !$omp end simd +end subroutine function1