diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -232,6 +232,18 @@ return true; } + bool Pre(const parser::StmtFunctionStmt &x) { + const auto &parsedExpr{std::get>(x.t)}; + if (const auto *expr{GetExpr(parsedExpr)}) { + for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) { + if (!IsStmtFunctionDummy(symbol)) { + stmtFunctionExprSymbols_.insert(symbol.GetUltimate()); + } + } + } + return true; + } + bool Pre(const parser::OpenMPBlockConstruct &); void Post(const parser::OpenMPBlockConstruct &); @@ -342,6 +354,7 @@ std::vector allocateNames_; // on one directive SymbolSet privateDataSharingAttributeObjects_; // on one directive + SymbolSet stmtFunctionExprSymbols_; void AddAllocateName(const parser::Name *&object) { allocateNames_.push_back(object); @@ -377,7 +390,7 @@ const parser::Name &, const Symbol &, Symbol::Flag); void CheckAssocLoopLevel(std::int64_t level, const parser::OmpClause *clause); - void CheckObjectInNamelist( + void CheckPrivateDSAObject( const parser::Name &, const Symbol &, Symbol::Flag); }; @@ -1163,7 +1176,7 @@ CheckMultipleAppearances(*name, *symbol, ompFlag); } if (privateDataSharingAttributeFlags.test(ompFlag)) { - CheckObjectInNamelist(*name, *symbol, ompFlag); + CheckPrivateDSAObject(*name, *symbol, ompFlag); } if (ompFlag == Symbol::Flag::OmpAllocate) { @@ -1317,18 +1330,28 @@ } } -void OmpAttributeVisitor::CheckObjectInNamelist( +void OmpAttributeVisitor::CheckPrivateDSAObject( const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) { - if (symbol.GetUltimate().test(Symbol::Flag::InNamelist)) { - llvm::StringRef clauseName{"PRIVATE"}; - if (ompFlag == Symbol::Flag::OmpFirstPrivate) - clauseName = "FIRSTPRIVATE"; - else if (ompFlag == Symbol::Flag::OmpLastPrivate) - clauseName = "LASTPRIVATE"; + const auto &ultimateSymbol{symbol.GetUltimate()}; + llvm::StringRef clauseName{"PRIVATE"}; + if (ompFlag == Symbol::Flag::OmpFirstPrivate) + clauseName = "FIRSTPRIVATE"; + else if (ompFlag == Symbol::Flag::OmpLastPrivate) + clauseName = "LASTPRIVATE"; + + if (ultimateSymbol.test(Symbol::Flag::InNamelist)) { context_.Say(name.source, "Variable '%s' in NAMELIST cannot be in a %s clause"_err_en_US, name.ToString(), clauseName.str()); } + + if (stmtFunctionExprSymbols_.find(ultimateSymbol) != + stmtFunctionExprSymbols_.end()) { + context_.Say(name.source, + "Variable '%s' in STATEMENT FUNCTION expression cannot be in a " + "%s clause"_err_en_US, + name.ToString(), clauseName.str()); + } } } // namespace Fortran::semantics diff --git a/flang/test/Semantics/omp-private03.f90 b/flang/test/Semantics/omp-private03.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-private03.f90 @@ -0,0 +1,39 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! Variables that appear in expressions for statement function definitions +! may not appear in private, firstprivate or lastprivate clauses. + +subroutine stmt_function(temp) + + integer :: i, p, q, r + real :: c, f, s, v, t(10) + real, intent(in) :: temp + + c(temp) = p * (temp - q) / r + f(temp) = q + (temp * r/p) + v(temp) = c(temp) + f(temp)/2 - s + + p = 5 + q = 32 + r = 9 + + !ERROR: Variable 'p' in STATEMENT FUNCTION expression cannot be in a PRIVATE clause + !$omp parallel private(p) + s = c(temp) + !$omp end parallel + + !ERROR: Variable 's' in STATEMENT FUNCTION expression cannot be in a FIRSTPRIVATE clause + !$omp parallel firstprivate(s) + s = s + f(temp) + !$omp end parallel + + !ERROR: Variable 's' in STATEMENT FUNCTION expression cannot be in a LASTPRIVATE clause + !$omp parallel do lastprivate(s, t) + do i = 1, 10 + t(i) = v(temp) + i - s + end do + !$omp end parallel do + + print *, t + +end subroutine stmt_function