[flang-commits] [flang] aae7eb8 - [Flang][Openmp] Fortran specific semantic checks for Allocate directive
Kiran Chandramohan via flang-commits
flang-commits at lists.llvm.org
Thu May 27 07:51:15 PDT 2021
Author: Isaac Perry
Date: 2021-05-27T15:42:33+01:00
New Revision: aae7eb809e41d9e1e95175a017ca0fdccc87dedd
URL: https://github.com/llvm/llvm-project/commit/aae7eb809e41d9e1e95175a017ca0fdccc87dedd
DIFF: https://github.com/llvm/llvm-project/commit/aae7eb809e41d9e1e95175a017ca0fdccc87dedd.diff
LOG: [Flang][Openmp] Fortran specific semantic checks for Allocate directive
This patch adds the following Fortran specific semantic checks for the OpenMP
Allocate directive.
1) A type parameter inquiry cannot appear in an ALLOCATE directive.
2) List items specified in the ALLOCATE directive must not have the ALLOCATABLE
attribute unless the directive is associated with an ALLOCATE statement.
Co-authored-by: Irina Dobrescu <irina.dobrescu at arm.com>
Reviewed By: kiranchandramohan
Differential Revision: https://reviews.llvm.org/D102061
Added:
flang/test/Semantics/omp-allocate06.f90
flang/test/Semantics/omp-allocate07.f90
Modified:
flang/include/flang/Semantics/symbol.h
flang/lib/Semantics/check-omp-structure.cpp
flang/lib/Semantics/check-omp-structure.h
flang/lib/Semantics/resolve-directives.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 309a1558480a0..293740851125f 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -508,9 +508,9 @@ class Symbol {
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<Flag, Flag_enumSize>;
const Scope &owner() const { return *owner_; }
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index b5658c66f527f..89107097e560a 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1131,6 +1131,26 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private);
}
+bool OmpStructureChecker::IsDataRefTypeParamInquiry(
+ const parser::DataRef *dataRef) {
+ bool dataRefIsTypeParamInquiry{false};
+ if (const auto *structComp{
+ parser::Unwrap<parser::StructureComponent>(dataRef)}) {
+ if (const auto *compSymbol{structComp->component.symbol}) {
+ if (const auto *compSymbolMiscDetails{
+ std::get_if<MiscDetails>(&compSymbol->details())}) {
+ const auto detailsKind = compSymbolMiscDetails->kind();
+ dataRefIsTypeParamInquiry =
+ (detailsKind == MiscDetails::Kind::KindParamInquiry ||
+ detailsKind == MiscDetails::Kind::LenParamInquiry);
+ } else if (compSymbol->has<TypeParamDetails>()) {
+ dataRefIsTypeParamInquiry = true;
+ }
+ }
+ }
+ return dataRefIsTypeParamInquiry;
+}
+
void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
const parser::CharBlock &source, const parser::OmpObjectList &objList) {
@@ -1138,9 +1158,14 @@ void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
std::visit(
common::visitors{
[&](const parser::Designator &designator) {
- if (std::get_if<parser::DataRef>(&designator.u)) {
- if ((parser::Unwrap<parser::StructureComponent>(ompObject)) ||
- (parser::Unwrap<parser::ArrayElement>(ompObject))) {
+ if (const auto *dataRef{
+ std::get_if<parser::DataRef>(&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<parser::StructureComponent>(
+ ompObject) ||
+ parser::Unwrap<parser::ArrayElement>(ompObject)) {
context_.Say(source,
"A variable that is part of another variable (as an "
"array or structure element)"
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index 1dfaa522a72bb..009c0850380eb 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -201,6 +201,7 @@ class OmpStructureChecker
void CheckDependList(const parser::DataRef &);
void CheckDependArraySection(
const common::Indirection<parser::ArrayElement> &, 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/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 342fc8f2b0f21..3147b4589cf76 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -1298,7 +1298,7 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclarativeAllocate &x) {
PushContext(x.source, llvm::omp::Directive::OMPD_allocate);
const auto &list{std::get<parser::OmpObjectList>(x.t)};
- ResolveOmpObjectList(list, Symbol::Flag::OmpAllocateDirective);
+ ResolveOmpObjectList(list, Symbol::Flag::OmpDeclarativeAllocateDirective);
return false;
}
@@ -1306,7 +1306,7 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPExecutableAllocate &x) {
PushContext(x.source, llvm::omp::Directive::OMPD_allocate);
const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)};
if (list)
- ResolveOmpObjectList(*list, Symbol::Flag::OmpAllocateDirective);
+ ResolveOmpObjectList(*list, Symbol::Flag::OmpExecutableAllocateDirective);
return true;
}
@@ -1482,7 +1482,16 @@ void OmpAttributeVisitor::ResolveOmpObject(
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
index 0000000000000..a6f8d6633d791
--- /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
index 0000000000000..b8125152b2e9b
--- /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
+
More information about the flang-commits
mailing list