diff --git a/flang/lib/Semantics/check-acc-structure.h b/flang/lib/Semantics/check-acc-structure.h --- a/flang/lib/Semantics/check-acc-structure.h +++ b/flang/lib/Semantics/check-acc-structure.h @@ -114,6 +114,9 @@ private: bool CheckAllowedModifier(llvm::acc::Clause clause); + bool IsComputeConstruct(llvm::acc::Directive directive) const; + bool IsInsideComputeConstruct() const; + void CheckNotInComputeConstruct(); llvm::StringRef getClauseName(llvm::acc::Clause clause) override; llvm::StringRef getDirectiveName(llvm::acc::Directive directive) override; }; diff --git a/flang/lib/Semantics/check-acc-structure.cpp b/flang/lib/Semantics/check-acc-structure.cpp --- a/flang/lib/Semantics/check-acc-structure.cpp +++ b/flang/lib/Semantics/check-acc-structure.cpp @@ -54,6 +54,35 @@ return false; } +bool AccStructureChecker::IsComputeConstruct( + llvm::acc::Directive directive) const { + return directive == llvm::acc::ACCD_parallel || + directive == llvm::acc::ACCD_parallel_loop || + directive == llvm::acc::ACCD_serial || + directive == llvm::acc::ACCD_serial_loop || + directive == llvm::acc::ACCD_kernels || + directive == llvm::acc::ACCD_kernels_loop; +} + +bool AccStructureChecker::IsInsideComputeConstruct() const { + if (dirContext_.size() <= 1) + return false; + + // Check all nested context skipping the first one. + for (std::size_t i = dirContext_.size() - 1; i > 0; --i) { + if (IsComputeConstruct(dirContext_[i - 1].directive)) + return true; + } + return false; +} + +void AccStructureChecker::CheckNotInComputeConstruct() { + if (IsInsideComputeConstruct()) + context_.Say(GetContext().directiveSource, + "Directive %s may not be called within a compute region"_err_en_US, + ContextDirectiveAsFortran()); +} + void AccStructureChecker::Enter(const parser::AccClause &x) { SetContextClause(x); } @@ -175,12 +204,16 @@ switch (standaloneDir.v) { case llvm::acc::Directive::ACCD_enter_data: case llvm::acc::Directive::ACCD_exit_data: - case llvm::acc::Directive::ACCD_set: // Restriction - line 1310-1311 (ENTER DATA) // Restriction - line 1312-1313 (EXIT DATA) - // Restriction - line 2610 (SET) CheckRequireAtLeastOneOf(); break; + case llvm::acc::Directive::ACCD_set: + // Restriction - line 2610 + CheckRequireAtLeastOneOf(); + // Restriction - line 2602 + CheckNotInComputeConstruct(); + break; case llvm::acc::Directive::ACCD_update: // Restriction - line 2636 CheckRequireAtLeastOneOf(); @@ -188,6 +221,12 @@ CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, updateOnlyAllowedAfterDeviceTypeClauses); break; + case llvm::acc::Directive::ACCD_init: + case llvm::acc::Directive::ACCD_shutdown: + // Restriction - line 2525 (INIT) + // Restriction - line 2561 (SHUTDOWN) + CheckNotInComputeConstruct(); + break; default: break; } diff --git a/flang/test/Semantics/acc-clause-validity.f90 b/flang/test/Semantics/acc-clause-validity.f90 --- a/flang/test/Semantics/acc-clause-validity.f90 +++ b/flang/test/Semantics/acc-clause-validity.f90 @@ -53,6 +53,195 @@ !$acc init device_type(2, i, j) !$acc init device_num(i) device_type(i, j) if(ifCondition) + !$acc parallel + !ERROR: Directive INIT may not be called within a compute region + !$acc init + !$acc end parallel + + !$acc serial + !ERROR: Directive INIT may not be called within a compute region + !$acc init + !$acc end serial + + !$acc kernels + !ERROR: Directive INIT may not be called within a compute region + !$acc init + !$acc end kernels + + !$acc parallel + !$acc loop + do i = 1, N + !ERROR: Directive INIT may not be called within a compute region + !$acc init + a(i) = 3.14 + end do + !$acc end parallel + + !$acc serial + !$acc loop + do i = 1, N + !ERROR: Directive INIT may not be called within a compute region + !$acc init + a(i) = 3.14 + end do + !$acc end serial + + !$acc kernels + !$acc loop + do i = 1, N + !ERROR: Directive INIT may not be called within a compute region + !$acc init + a(i) = 3.14 + end do + !$acc end kernels + + !$acc parallel loop + do i = 1, N + !ERROR: Directive INIT may not be called within a compute region + !$acc init + a(i) = 3.14 + end do + + !$acc serial loop + do i = 1, N + !ERROR: Directive INIT may not be called within a compute region + !$acc init + a(i) = 3.14 + end do + + !$acc kernels loop + do i = 1, N + !ERROR: Directive INIT may not be called within a compute region + !$acc init + a(i) = 3.14 + end do + + !$acc parallel + !ERROR: Directive SHUTDOWN may not be called within a compute region + !$acc shutdown + !$acc end parallel + + !$acc serial + !ERROR: Directive SHUTDOWN may not be called within a compute region + !$acc shutdown + !$acc end serial + + !$acc kernels + !ERROR: Directive SHUTDOWN may not be called within a compute region + !$acc shutdown + !$acc end kernels + + !$acc parallel + !$acc loop + do i = 1, N + !ERROR: Directive SHUTDOWN may not be called within a compute region + !$acc shutdown + a(i) = 3.14 + end do + !$acc end parallel + + !$acc serial + !$acc loop + do i = 1, N + !ERROR: Directive SHUTDOWN may not be called within a compute region + !$acc shutdown + a(i) = 3.14 + end do + !$acc end serial + + !$acc kernels + !$acc loop + do i = 1, N + !ERROR: Directive SHUTDOWN may not be called within a compute region + !$acc shutdown + a(i) = 3.14 + end do + !$acc end kernels + + !$acc parallel loop + do i = 1, N + !ERROR: Directive SHUTDOWN may not be called within a compute region + !$acc shutdown + a(i) = 3.14 + end do + + !$acc serial loop + do i = 1, N + !ERROR: Directive SHUTDOWN may not be called within a compute region + !$acc shutdown + a(i) = 3.14 + end do + + !$acc kernels loop + do i = 1, N + !ERROR: Directive SHUTDOWN may not be called within a compute region + !$acc shutdown + a(i) = 3.14 + end do + + !$acc parallel + !ERROR: Directive SET may not be called within a compute region + !$acc set default_async(i) + !$acc end parallel + + !$acc serial + !ERROR: Directive SET may not be called within a compute region + !$acc set default_async(i) + !$acc end serial + + !$acc kernels + !ERROR: Directive SET may not be called within a compute region + !$acc set default_async(i) + !$acc end kernels + + !$acc parallel + !$acc loop + do i = 1, N + !ERROR: Directive SET may not be called within a compute region + !$acc set default_async(i) + a(i) = 3.14 + end do + !$acc end parallel + + !$acc serial + !$acc loop + do i = 1, N + !ERROR: Directive SET may not be called within a compute region + !$acc set default_async(i) + a(i) = 3.14 + end do + !$acc end serial + + !$acc kernels + !$acc loop + do i = 1, N + !ERROR: Directive SET may not be called within a compute region + !$acc set default_async(i) + a(i) = 3.14 + end do + !$acc end kernels + + !$acc parallel loop + do i = 1, N + !ERROR: Directive SET may not be called within a compute region + !$acc set default_async(i) + a(i) = 3.14 + end do + + !$acc serial loop + do i = 1, N + !ERROR: Directive SET may not be called within a compute region + !$acc set default_async(i) + a(i) = 3.14 + end do + + !$acc kernels loop + do i = 1, N + !ERROR: Directive SET may not be called within a compute region + !$acc set default_async(i) + a(i) = 3.14 + end do + !ERROR: At least one of DEFAULT_ASYNC, DEVICE_NUM, DEVICE_TYPE clause must appear on the SET directive !$acc set