maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[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@arm.com>

Reviewed By: kiranchandramohan

Differential Revision: https://reviews.llvm.org/D102061
This commit is contained in:
Isaac Perry 2021-05-27 08:56:16 +01:00 committed by Kiran Chandramohan
parent 808dc6f866
commit aae7eb809e
6 changed files with 97 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
flang/include/flang/Semantics/symbol.h
View File

@ -508,9 +508,9 @@ public:
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_; }

31
flang/lib/Semantics/check-omp-structure.cpp
View File

@ -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)"

1
flang/lib/Semantics/check-omp-structure.h
View File

@ -201,6 +201,7 @@ private:
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(

15
flang/lib/Semantics/resolve-directives.cpp
View File

@ -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 "

18
flang/test/Semantics/omp-allocate06.f90 Normal file
View File

@ -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

35
flang/test/Semantics/omp-allocate07.f90 Normal file
View File

@ -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