diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -508,9 +508,9 @@ OmpCopyIn, OmpCopyPrivate, // OpenMP miscellaneous flags OmpCommonBlock, OmpReduction, OmpAligned, OmpAllocate, - OmpAllocateDirective, OmpDeclareSimd, OmpDeclareTarget, OmpThreadprivate, - OmpDeclareReduction, OmpFlushed, OmpCriticalLock, OmpIfSpecified, OmpNone, - OmpPreDetermined); + OmpDeclarativeAllocateDirective, OmpExecutableAllocateDirective, + OmpDeclareSimd, OmpDeclareTarget, OmpThreadprivate, OmpDeclareReduction, + OmpFlushed, OmpCriticalLock, OmpIfSpecified, OmpNone, OmpPreDetermined); using Flags = common::EnumSet; const Scope &owner() const { return *owner_; } diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -201,6 +201,7 @@ void CheckDependList(const parser::DataRef &); void CheckDependArraySection( const common::Indirection &, const parser::Name &); + bool IsDataRefTypeParamInquiry(const parser::DataRef *dataRef); void CheckIsVarPartOfAnotherVar( const parser::CharBlock &source, const parser::OmpObjectList &objList); void CheckIntentInPointer( 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 @@ -1131,6 +1131,26 @@ CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private); } +bool OmpStructureChecker::IsDataRefTypeParamInquiry( + const parser::DataRef *dataRef) { + bool dataRefIsTypeParamInquiry{false}; + if (const auto *structComp{ + parser::Unwrap(dataRef)}) { + if (const auto *compSymbol{structComp->component.symbol}) { + if (const auto *compSymbolMiscDetails{ + std::get_if(&compSymbol->details())}) { + const auto detailsKind = compSymbolMiscDetails->kind(); + dataRefIsTypeParamInquiry = + (detailsKind == MiscDetails::Kind::KindParamInquiry || + detailsKind == MiscDetails::Kind::LenParamInquiry); + } else if (compSymbol->has()) { + dataRefIsTypeParamInquiry = true; + } + } + } + return dataRefIsTypeParamInquiry; +} + void OmpStructureChecker::CheckIsVarPartOfAnotherVar( const parser::CharBlock &source, const parser::OmpObjectList &objList) { @@ -1138,9 +1158,14 @@ std::visit( common::visitors{ [&](const parser::Designator &designator) { - if (std::get_if(&designator.u)) { - if ((parser::Unwrap(ompObject)) || - (parser::Unwrap(ompObject))) { + if (const auto *dataRef{ + std::get_if(&designator.u)}) { + if (IsDataRefTypeParamInquiry(dataRef)) { + context_.Say(source, + "A type parameter inquiry cannot appear in an ALLOCATE directive"_err_en_US); + } else if (parser::Unwrap( + ompObject) || + parser::Unwrap(ompObject)) { context_.Say(source, "A variable that is part of another variable (as an " "array or structure element)" 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 @@ -1298,7 +1298,7 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclarativeAllocate &x) { PushContext(x.source, llvm::omp::Directive::OMPD_allocate); const auto &list{std::get(x.t)}; - ResolveOmpObjectList(list, Symbol::Flag::OmpAllocateDirective); + ResolveOmpObjectList(list, Symbol::Flag::OmpDeclarativeAllocateDirective); return false; } @@ -1306,7 +1306,7 @@ PushContext(x.source, llvm::omp::Directive::OMPD_allocate); const auto &list{std::get>(x.t)}; if (list) - ResolveOmpObjectList(*list, Symbol::Flag::OmpAllocateDirective); + ResolveOmpObjectList(*list, Symbol::Flag::OmpExecutableAllocateDirective); return true; } @@ -1482,7 +1482,16 @@ AddAllocateName(name); } } - if (ompFlag == Symbol::Flag::OmpAllocateDirective && + if (ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective && + IsAllocatable(*symbol)) { + context_.Say(designator.source, + "List items specified in the ALLOCATE directive must not " + "have the ALLOCATABLE attribute unless the directive is " + "associated with an ALLOCATE statement"_err_en_US); + } + if ((ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective || + ompFlag == + Symbol::Flag::OmpExecutableAllocateDirective) && ResolveOmpObjectScope(name) == nullptr) { context_.Say(designator.source, // 2.15.3 "List items must be declared in the same scoping unit " diff --git a/flang/test/Semantics/omp-allocate06.f90 b/flang/test/Semantics/omp-allocate06.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-allocate06.f90 @@ -0,0 +1,18 @@ +! RUN: %S/test_errors.sh %s %t %flang_fc1 -fopenmp +! OpenMP Version 5.0 +! 2.11.3 allocate Directive +! List items specified in the allocate directive must not have the ALLOCATABLE attribute unless the directive is associated with an +! allocate statement. + +subroutine allocate() +use omp_lib + integer :: a, b, x + real, dimension (:,:), allocatable :: darray + + !ERROR: List items specified in the ALLOCATE directive must not have the ALLOCATABLE attribute unless the directive is associated with an ALLOCATE statement + !$omp allocate(darray) allocator(omp_default_mem_alloc) + + !$omp allocate(darray) allocator(omp_default_mem_alloc) + allocate(darray(a, b)) + +end subroutine allocate diff --git a/flang/test/Semantics/omp-allocate07.f90 b/flang/test/Semantics/omp-allocate07.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-allocate07.f90 @@ -0,0 +1,35 @@ +! RUN: %S/test_errors.sh %s %t %flang_fc1 -fopenmp +! OpenMP Version 5.0 +! 2.11.3 allocate Directive +! A type parameter inquiry cannot appear in an allocate directive. + +subroutine allocate() +use omp_lib + type my_type(kind_param, len_param) + INTEGER, KIND :: kind_param + INTEGER, LEN :: len_param + INTEGER :: array(10) + end type + + type(my_type(2, 4)) :: my_var + INTEGER(KIND=4) :: x + CHARACTER(LEN=32) :: w + INTEGER, DIMENSION(:), ALLOCATABLE :: y + + !ERROR: A type parameter inquiry cannot appear in an ALLOCATE directive + !$omp allocate(x%KIND) + + !ERROR: A type parameter inquiry cannot appear in an ALLOCATE directive + !$omp allocate(w%LEN) + + !ERROR: A type parameter inquiry cannot appear in an ALLOCATE directive + !$omp allocate(y%KIND) + + !ERROR: A type parameter inquiry cannot appear in an ALLOCATE directive + !$omp allocate(my_var%kind_param) + + !ERROR: A type parameter inquiry cannot appear in an ALLOCATE directive + !$omp allocate(my_var%len_param) + +end subroutine allocate +