Index: flang/lib/Semantics/check-omp-structure.h =================================================================== --- flang/lib/Semantics/check-omp-structure.h +++ flang/lib/Semantics/check-omp-structure.h @@ -210,6 +210,8 @@ bool IsDataRefTypeParamInquiry(const parser::DataRef *dataRef); void CheckIsVarPartOfAnotherVar( const parser::CharBlock &source, const parser::OmpObjectList &objList); + void CheckThreadprivateOrDeclareTargetVar( + const parser::OmpObjectList &objList); void CheckIntentInPointer( const parser::OmpObjectList &, const llvm::omp::Clause); void GetSymbolsInObjectList(const parser::OmpObjectList &, SymbolSourceMap &); Index: flang/lib/Semantics/check-omp-structure.cpp =================================================================== --- flang/lib/Semantics/check-omp-structure.cpp +++ flang/lib/Semantics/check-omp-structure.cpp @@ -816,6 +816,42 @@ } } +void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar( + const parser::OmpObjectList &objList) { + for (const auto &ompObject : objList.v) { + std::visit( + common::visitors{ + [&](const parser::Designator &) { + if (const auto *name{parser::Unwrap(ompObject)}) { + const auto &scope{context_.FindScope(name->symbol->name())}; + 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) { + 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)) { + context_.Say(name->source, + "A variable in a %s directive cannot appear in an " + "EQUIVALENCE statement"_err_en_US, + ContextDirectiveAsFortran()); + } + } + }, + [&](const parser::Name &) {}, // common block + }, + ompObject.u); + } +} + void OmpStructureChecker::Enter(const parser::OpenMPThreadprivate &c) { const auto &dir{std::get(c.t)}; PushContextAndClauseSets( @@ -826,6 +862,7 @@ const auto &dir{std::get(c.t)}; const auto &objectList{std::get(c.t)}; CheckIsVarPartOfAnotherVar(dir.source, objectList); + CheckThreadprivateOrDeclareTargetVar(objectList); dirContext_.pop_back(); } @@ -871,7 +908,25 @@ } } -void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &) { +void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &x) { + const auto &dir{std::get(x.t)}; + const auto &spec{std::get(x.t)}; + if (const auto *objectList{parser::Unwrap(spec.u)}) { + CheckIsVarPartOfAnotherVar(dir.source, *objectList); + CheckThreadprivateOrDeclareTargetVar(*objectList); + } else if (const auto *clauseList{ + parser::Unwrap(spec.u)}) { + for (const auto &clause : clauseList->v) { + if (const auto *toClause{std::get_if(&clause.u)}) { + CheckIsVarPartOfAnotherVar(dir.source, toClause->v); + CheckThreadprivateOrDeclareTargetVar(toClause->v); + } else if (const auto *linkClause{ + std::get_if(&clause.u)}) { + CheckIsVarPartOfAnotherVar(dir.source, linkClause->v); + CheckThreadprivateOrDeclareTargetVar(linkClause->v); + } + } + } dirContext_.pop_back(); } @@ -1532,7 +1587,8 @@ void OmpStructureChecker::CheckIsVarPartOfAnotherVar( const parser::CharBlock &source, const parser::OmpObjectList &objList) { OmpDirectiveSet nonPartialVarSet{llvm::omp::Directive::OMPD_allocate, - llvm::omp::Directive::OMPD_threadprivate}; + llvm::omp::Directive::OMPD_threadprivate, + llvm::omp::Directive::OMPD_declare_target}; for (const auto &ompObject : objList.v) { std::visit( common::visitors{ Index: flang/test/Semantics/omp-declarative-directive.f90 =================================================================== --- flang/test/Semantics/omp-declarative-directive.f90 +++ flang/test/Semantics/omp-declarative-directive.f90 @@ -44,13 +44,20 @@ 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 !$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 + !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(Q, S) link(R) !ERROR: MAP clause is not allowed on the DECLARE TARGET directive !$omp declare target map(from:Q) integer, parameter :: N=10000, M=1024 integer :: i real :: Q(N, N), R(N,M), S(M,M) + !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(i) end subroutine foo end module m2 Index: flang/test/Semantics/omp-declare-target01.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/omp-declare-target01.f90 @@ -0,0 +1,113 @@ +! 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 declare_target01 + use omp_lib + type my_type(kind_param, len_param) + integer, KIND :: kind_param + integer, LEN :: len_param + integer :: t_i + integer :: t_arr(10) + end type my_type + + type(my_type(2, 4)) :: my_var, my_var2 + integer :: arr(10), arr2(10) + integer(kind=4) :: x, x2 + character(len=32) :: w, w2 + integer, dimension(:), allocatable :: y, y2 + + !$omp declare target (my_var) + + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the DECLARE TARGET directive + !$omp declare target (my_var%t_i) + + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the DECLARE TARGET directive + !$omp declare target (my_var%t_arr) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target (my_var%kind_param) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target (my_var%len_param) + + !$omp declare target (arr) + + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the DECLARE TARGET directive + !$omp declare target (arr(1)) + + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the DECLARE TARGET directive + !$omp declare target (arr(1:2)) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target (x%KIND) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target (w%LEN) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target (y%KIND) + + !$omp declare target to (my_var) + + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the DECLARE TARGET directive + !$omp declare target to (my_var%t_i) + + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the DECLARE TARGET directive + !$omp declare target to (my_var%t_arr) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target to (my_var%kind_param) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target to (my_var%len_param) + + !$omp declare target to (arr) + + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the DECLARE TARGET directive + !$omp declare target to (arr(1)) + + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the DECLARE TARGET directive + !$omp declare target to (arr(1:2)) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target to (x%KIND) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target to (w%LEN) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target to (y%KIND) + + !$omp declare target link (my_var2) + + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the DECLARE TARGET directive + !$omp declare target link (my_var2%t_i) + + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the DECLARE TARGET directive + !$omp declare target link (my_var2%t_arr) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target link (my_var2%kind_param) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target link (my_var2%len_param) + + !$omp declare target link (arr2) + + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the DECLARE TARGET directive + !$omp declare target link (arr2(1)) + + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the DECLARE TARGET directive + !$omp declare target link (arr2(1:2)) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target link (x2%KIND) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target link (w2%LEN) + + !ERROR: A type parameter inquiry cannot appear on the DECLARE TARGET directive + !$omp declare target link (y2%KIND) +end Index: flang/test/Semantics/omp-declare-target02.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/omp-declare-target02.f90 @@ -0,0 +1,176 @@ +! 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 declare_target02 + integer :: arr1(10), arr1_to(10), arr1_link(10) + common /blk1/ a1, a1_to, a1_link + real, save :: eq_a, eq_b, eq_c, eq_d + + + !$omp declare target (arr1) + + !$omp declare target (blk1) + + !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block + !$omp declare target (a1) + + !$omp declare target to (arr1_to) + + !$omp declare target to (blk1_to) + + !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block + !$omp declare target to (a1_to) + + !$omp declare target link (arr1_link) + + !$omp declare target link (blk1_link) + + !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block + !$omp declare target link (a1_link) + + equivalence(eq_a, eq_b) + !ERROR: A variable in a DECLARE TARGET directive cannot appear in an EQUIVALENCE statement + !$omp declare target (eq_a) + + !ERROR: A variable in a DECLARE TARGET directive cannot appear in an EQUIVALENCE statement + !$omp declare target to (eq_a) + + !ERROR: A variable in a DECLARE TARGET directive cannot appear in an EQUIVALENCE statement + !$omp declare target link (eq_b) + + !ERROR: A variable in a DECLARE TARGET directive cannot appear in an EQUIVALENCE statement + !$omp declare target (eq_c) + + !ERROR: A variable in a DECLARE TARGET directive cannot appear in an EQUIVALENCE statement + !$omp declare target to (eq_c) + + !ERROR: A variable in a DECLARE TARGET directive cannot appear in an EQUIVALENCE statement + !$omp declare target link (eq_d) + equivalence(eq_c, eq_d) + +contains + subroutine func() + integer :: arr2(10), arr2_to(10), arr2_link(10) + integer, save :: arr3(10), arr3_to(10), arr3_link(10) + common /blk2/ a2, a2_to, a2_link + common /blk3/ a3, a3_to, a3_link + save /blk3/ + + !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 (arr2) + + !$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) + + !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 (arr2_to) + + !$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) + + !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 (arr2_link) + + !$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 +end + +module mod4 + integer :: arr4(10), arr4_to(10), arr4_link(10) + common /blk4/ a4, a4_to, a4_link + + !$omp declare target (arr4) + + !$omp declare target (blk4) + + !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block + !$omp declare target (a4) + + !$omp declare target to (arr4_to) + + !$omp declare target to (blk4_to) + + !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block + !$omp declare target to (a4_to) + + !$omp declare target link (arr4_link) + + !$omp declare target link (blk4_link) + + !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block + !$omp declare target link (a4_link) +end + +subroutine func5() + integer :: arr5(10), arr5_to(10), arr5_link(10) + common /blk5/ a5, a5_to, a5_link + + !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 (arr5) + + !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 (blk5) + + !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block + !$omp declare target (a5) + + !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 (arr5_to) + + !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 (blk5_to) + + !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block + !$omp declare target to (a5_to) + + !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 (arr5_link) + + !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 (blk5_link) + + !ERROR: A variable in a DECLARE TARGET directive cannot be an element of a common block + !$omp declare target link (a5_link) +end Index: flang/test/Semantics/omp-threadprivate02.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/omp-threadprivate02.f90 @@ -0,0 +1,89 @@ +! 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 threadprivate02 + integer :: arr1(10) + common /blk1/ a1 + real, save :: eq_a, eq_b, eq_c, eq_d + + !$omp threadprivate(arr1) + + !$omp threadprivate(/blk1/) + + !$omp threadprivate(blk1) + + !ERROR: A variable in a THREADPRIVATE directive cannot be an element of a common block + !$omp threadprivate(a1) + + equivalence(eq_a, eq_b) + !ERROR: A variable in a THREADPRIVATE directive cannot appear in an EQUIVALENCE statement + !$omp threadprivate(eq_a) + + !ERROR: A variable in a THREADPRIVATE directive cannot appear in an EQUIVALENCE statement + !$omp threadprivate(eq_c) + equivalence(eq_c, eq_d) + +contains + subroutine func() + integer :: arr2(10) + integer, save :: arr3(10) + common /blk2/ a2 + common /blk3/ a3 + save /blk3/ + + !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(arr2) + + !$omp threadprivate(arr3) + + !$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 +end + +module mod4 + integer :: arr4(10) + common /blk4/ a4 + + !$omp threadprivate(arr4) + + !$omp threadprivate(/blk4/) + + !$omp threadprivate(blk4) + + !ERROR: A variable in a THREADPRIVATE directive cannot be an element of a common block + !$omp threadprivate(a4) +end + +subroutine func5() + integer :: arr5(10) + common /blk5/ a5 + + !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(arr5) + + !$omp threadprivate(/blk5/) + + !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(blk5) + + !ERROR: A variable in a THREADPRIVATE directive cannot be an element of a common block + !$omp threadprivate(a5) +end