diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -844,26 +844,63 @@ common::visitors{ [&](const parser::Designator &) { if (const auto *name{parser::Unwrap(ompObject)}) { - const auto &scope{context_.FindScope(name->symbol->name())}; - if (FindCommonBlockContaining(*name->symbol)) { + const auto &declScope{ + GetProgramUnitContaining(name->symbol->GetUltimate())}; + const auto *sym = + declScope.parent().FindSymbol(name->symbol->name()); + if (sym && + (sym->has() || + sym->has())) { + context_.Say(name->source, + "The module name or main program name cannot be in a %s " + "directive"_err_en_US, + ContextDirectiveAsFortran()); + } else if (name->symbol->GetUltimate().IsSubprogram()) { + if (GetContext().directive == + llvm::omp::Directive::OMPD_threadprivate) + context_.Say(name->source, + "The procedure name cannot be in a %s " + "directive"_err_en_US, + ContextDirectiveAsFortran()); + // TODO: Check for procedure name in declare target directive. + } else if (name->symbol->attrs().test(Attr::PARAMETER)) { + if (GetContext().directive == + llvm::omp::Directive::OMPD_threadprivate) + context_.Say(name->source, + "The entity with PARAMETER attribute cannot be in a %s " + "directive"_err_en_US, + ContextDirectiveAsFortran()); + else if (GetContext().directive == + llvm::omp::Directive::OMPD_declare_target) + context_.Say(name->source, + "The entity with PARAMETER attribute is used in a %s " + "directive"_en_US, + ContextDirectiveAsFortran()); + } else if (FindCommonBlockContaining(*name->symbol)) { context_.Say(name->source, "A variable in a %s directive cannot be an element of a " "common block"_err_en_US, ContextDirectiveAsFortran()); } else if (!IsSave(*name->symbol) && - scope.kind() != Scope::Kind::MainProgram && - scope.kind() != Scope::Kind::Module) { + declScope.kind() != Scope::Kind::MainProgram && + declScope.kind() != Scope::Kind::Module) { context_.Say(name->source, "A variable that appears in a %s directive must be " "declared in the scope of a module or have the SAVE " "attribute, either explicitly or implicitly"_err_en_US, ContextDirectiveAsFortran()); - } - if (FindEquivalenceSet(*name->symbol)) { + } else if (FindEquivalenceSet(*name->symbol)) { context_.Say(name->source, "A variable in a %s directive cannot appear in an " "EQUIVALENCE statement"_err_en_US, ContextDirectiveAsFortran()); + } else if (name->symbol->test(Symbol::Flag::OmpThreadprivate) && + GetContext().directive == + llvm::omp::Directive::OMPD_declare_target) { + context_.Say(name->source, + "A THREADPRIVATE variable cannot appear in a %s " + "directive"_err_en_US, + ContextDirectiveAsFortran()); } } }, @@ -1407,6 +1444,49 @@ llvm::omp::Clause::OMPC_copyprivate, {llvm::omp::Clause::OMPC_nowait}); } + auto testThreadprivateVarErr = [&](Symbol sym, parser::Name name, + llvmOmpClause clauseTy) { + if (sym.test(Symbol::Flag::OmpThreadprivate)) + context_.Say(name.source, + "A THREADPRIVATE variable cannot be in %s clause"_err_en_US, + parser::ToUpperCaseLetters(getClauseName(clauseTy).str())); + }; + + // [5.1] 2.21.2 Threadprivate Directive Restriction + OmpClauseSet threadprivateAllowedSet{llvm::omp::Clause::OMPC_copyin, + llvm::omp::Clause::OMPC_copyprivate, llvm::omp::Clause::OMPC_schedule, + llvm::omp::Clause::OMPC_num_threads, llvm::omp::Clause::OMPC_thread_limit, + llvm::omp::Clause::OMPC_if}; + for (auto it : GetContext().clauseInfo) { + llvmOmpClause type = it.first; + const auto *clause = it.second; + if (!threadprivateAllowedSet.test(type)) { + if (const auto *objList{GetOmpObjectList(*clause)}) { + for (const auto &ompObject : objList->v) { + std::visit( + common::visitors{ + [&](const parser::Designator &) { + if (const auto *name{ + parser::Unwrap(ompObject)}) + testThreadprivateVarErr( + name->symbol->GetUltimate(), *name, type); + }, + [&](const parser::Name &name) { + if (name.symbol) { + for (const auto &mem : + name.symbol->get().objects()) { + testThreadprivateVarErr(mem->GetUltimate(), name, type); + break; + } + } + }, + }, + ompObject.u); + } + } + } + } + CheckRequireAtLeastOneOf(); } diff --git a/flang/test/Semantics/omp-declarative-directive.f90 b/flang/test/Semantics/omp-declarative-directive.f90 --- a/flang/test/Semantics/omp-declarative-directive.f90 +++ b/flang/test/Semantics/omp-declarative-directive.f90 @@ -44,9 +44,8 @@ contains subroutine foo !$omp declare target - !ERROR: A variable that appears in a DECLARE TARGET directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly - !ERROR: A variable that appears in a DECLARE TARGET directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly - !ERROR: A variable that appears in a DECLARE TARGET directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly + !WARNING: The entity with PARAMETER attribute is used in a DECLARE TARGET directive + !WARNING: The entity with PARAMETER attribute is used in a DECLARE TARGET directive !$omp declare target (foo, N, M) !ERROR: A variable that appears in a DECLARE TARGET directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly !ERROR: A variable that appears in a DECLARE TARGET directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly diff --git a/flang/test/Semantics/omp-declare-target02.f90 b/flang/test/Semantics/omp-declare-target02.f90 --- a/flang/test/Semantics/omp-declare-target02.f90 +++ b/flang/test/Semantics/omp-declare-target02.f90 @@ -63,17 +63,9 @@ !$omp declare target (arr3) - !ERROR: Implicitly typed local entity 'blk2' not allowed in specification expression - !ERROR: A variable that appears in a DECLARE TARGET directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly - !$omp declare target (blk2) - !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block !$omp declare target (a2) - !ERROR: Implicitly typed local entity 'blk3' not allowed in specification expression - !ERROR: A variable that appears in a DECLARE TARGET directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly - !$omp declare target (blk3) - !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block !$omp declare target (a3) @@ -82,17 +74,9 @@ !$omp declare target to (arr3_to) - !ERROR: Implicitly typed local entity 'blk2_to' not allowed in specification expression - !ERROR: A variable that appears in a DECLARE TARGET directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly - !$omp declare target to (blk2_to) - !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block !$omp declare target to (a2_to) - !ERROR: Implicitly typed local entity 'blk3_to' not allowed in specification expression - !ERROR: A variable that appears in a DECLARE TARGET directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly - !$omp declare target to (blk3_to) - !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block !$omp declare target to (a3_to) @@ -101,17 +85,9 @@ !$omp declare target link (arr3_link) - !ERROR: Implicitly typed local entity 'blk2_link' not allowed in specification expression - !ERROR: A variable that appears in a DECLARE TARGET directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly - !$omp declare target link (blk2_link) - !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block !$omp declare target link (a2_link) - !ERROR: Implicitly typed local entity 'blk3_link' not allowed in specification expression - !ERROR: A variable that appears in a DECLARE TARGET directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly - !$omp declare target link (blk3_link) - !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block !$omp declare target link (a3_link) end diff --git a/flang/test/Semantics/omp-declare-target03.f90 b/flang/test/Semantics/omp-declare-target03.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-declare-target03.f90 @@ -0,0 +1,17 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -fopenmp +! OpenMP Version 5.1 +! Check OpenMP construct validity for the following directives: +! 2.14.7 Declare Target Directive + +module mod1 +end + +program main + use mod1 + + !ERROR: The module name or main program name cannot be in a DECLARE TARGET directive + !$omp declare target (mod1) + + !ERROR: The module name or main program name cannot be in a DECLARE TARGET directive + !$omp declare target (main) +end diff --git a/flang/test/Semantics/omp-declare-target04.f90 b/flang/test/Semantics/omp-declare-target04.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-declare-target04.f90 @@ -0,0 +1,16 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -fopenmp +! OpenMP Version 5.1 +! Check OpenMP construct validity for the following directives: +! 2.14.7 Declare Target Directive + +program main + integer, save :: x, y + + !$omp threadprivate(x) + + !ERROR: A THREADPRIVATE variable cannot appear in a DECLARE TARGET directive + !ERROR: A THREADPRIVATE variable cannot appear in a DECLARE TARGET directive + !$omp declare target (x, y) + + !$omp threadprivate(y) +end diff --git a/flang/test/Semantics/omp-threadprivate02.f90 b/flang/test/Semantics/omp-threadprivate02.f90 --- a/flang/test/Semantics/omp-threadprivate02.f90 +++ b/flang/test/Semantics/omp-threadprivate02.f90 @@ -40,19 +40,11 @@ !$omp threadprivate(/blk2/) - !ERROR: Implicitly typed local entity 'blk2' not allowed in specification expression - !ERROR: A variable that appears in a THREADPRIVATE directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly - !$omp threadprivate(blk2) - !ERROR: A variable in a THREADPRIVATE directive cannot be an element of a common block !$omp threadprivate(a2) !$omp threadprivate(/blk3/) - !ERROR: Implicitly typed local entity 'blk3' not allowed in specification expression - !ERROR: A variable that appears in a THREADPRIVATE directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly - !$omp threadprivate(blk3) - !ERROR: A variable in a THREADPRIVATE directive cannot be an element of a common block !$omp threadprivate(a3) end diff --git a/flang/test/Semantics/omp-threadprivate03.f90 b/flang/test/Semantics/omp-threadprivate03.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-threadprivate03.f90 @@ -0,0 +1,27 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -fopenmp +! OpenMP Version 5.1 +! Check OpenMP construct validity for the following directives: +! 2.21.2 Threadprivate Directive + +module mod1 +end + +program main + use mod1 + integer, parameter :: i = 1 + + !ERROR: The module name or main program name cannot be in a THREADPRIVATE directive + !$omp threadprivate(mod1) + + !ERROR: The module name or main program name cannot be in a THREADPRIVATE directive + !$omp threadprivate(main) + + !ERROR: The entity with PARAMETER attribute cannot be in a THREADPRIVATE directive + !$omp threadprivate(i) + +contains + subroutine sub() + !ERROR: The procedure name cannot be in a THREADPRIVATE directive + !$omp threadprivate(sub) + end +end diff --git a/flang/test/Semantics/omp-threadprivate04.f90 b/flang/test/Semantics/omp-threadprivate04.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-threadprivate04.f90 @@ -0,0 +1,48 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -fopenmp +! OpenMP Version 5.1 +! Check OpenMP construct validity for the following directives: +! 2.21.2 Threadprivate Directive + +program main + integer :: i, N = 10 + integer, save :: x + common /blk/ y + + !$omp threadprivate(x, /blk/) + + !$omp parallel num_threads(x) + !$omp end parallel + + !$omp single copyprivate(x, /blk/) + !$omp end single + + !$omp do schedule(static, x) + do i = 1, N + y = x + end do + !$omp end do + + !$omp parallel copyin(x, /blk/) + !$omp end parallel + + !$omp parallel if(x > 1) + !$omp end parallel + + !$omp teams thread_limit(x) + !$omp end teams + + !ERROR: A THREADPRIVATE variable cannot be in PRIVATE clause + !ERROR: A THREADPRIVATE variable cannot be in PRIVATE clause + !$omp parallel private(x, /blk/) + !$omp end parallel + + !ERROR: A THREADPRIVATE variable cannot be in FIRSTPRIVATE clause + !ERROR: A THREADPRIVATE variable cannot be in FIRSTPRIVATE clause + !$omp parallel firstprivate(x, /blk/) + !$omp end parallel + + !ERROR: A THREADPRIVATE variable cannot be in SHARED clause + !ERROR: A THREADPRIVATE variable cannot be in SHARED clause + !$omp parallel shared(x, /blk/) + !$omp end parallel +end