Skip to content

Commit 5529150

Browse files
authored
Merge 818557b into e2e776c
2 parents e2e776c + 818557b commit 5529150

File tree

2 files changed

+37
-2
lines changed

2 files changed

+37
-2
lines changed

flang/lib/Semantics/check-omp-structure.cpp

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1692,6 +1692,28 @@ void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
16921692
const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
16931693
PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
16941694
const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
1695+
SymbolSourceMap currSymbols;
1696+
GetSymbolsInObjectList(objectList, currSymbols);
1697+
for (auto &[symbol, source] : currSymbols) {
1698+
if (IsPointer(*symbol)) {
1699+
context_.Say(source,
1700+
"List item '%s' in ALLOCATE directive must not have POINTER "
1701+
"attribute"_err_en_US,
1702+
source.ToString());
1703+
}
1704+
if (IsDummy(*symbol)) {
1705+
context_.Say(source,
1706+
"List item '%s' in ALLOCATE directive must not be a dummy "
1707+
"argument"_err_en_US,
1708+
source.ToString());
1709+
}
1710+
if (symbol->has<AssocEntityDetails>()) {
1711+
context_.Say(source,
1712+
"List item '%s' in ALLOCATE directive must not be an associate "
1713+
"name"_err_en_US,
1714+
source.ToString());
1715+
}
1716+
}
16951717
for (const auto &clause : clauseList.v) {
16961718
CheckAlignValue(clause);
16971719
}

flang/test/Semantics/OpenMP/allocate04.f90

Lines changed: 15 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4,13 +4,26 @@
44
! OpenMP Version 5.0
55
! 2.11.3 allocate Directive
66
! Only the allocator clause is allowed on the allocate directive
7-
subroutine allocate()
7+
! List item in ALLOCATE directive must not be a dummy argument
8+
! List item in ALLOCATE directive must not have POINTER attribute
9+
! List item in ALLOCATE directive must not be a associate name
10+
subroutine allocate(z)
811
use omp_lib
12+
use iso_c_binding
913

10-
integer :: x, y
14+
type(c_ptr), pointer :: p
15+
integer :: x, y, z
1116

17+
associate (a => x)
1218
!$omp allocate(x) allocator(omp_default_mem_alloc)
1319

1420
!ERROR: PRIVATE clause is not allowed on the ALLOCATE directive
1521
!$omp allocate(y) private(y)
22+
!ERROR: List item 'z' in ALLOCATE directive must not be a dummy argument
23+
!$omp allocate(z)
24+
!ERROR: List item 'p' in ALLOCATE directive must not have POINTER attribute
25+
!$omp allocate(p)
26+
!ERROR: List item 'a' in ALLOCATE directive must not be an associate name
27+
!$omp allocate(a)
28+
end associate
1629
end subroutine allocate

0 commit comments

Comments
 (0)