Skip to content

Commit d6b69a1

Browse files
authored
[flang][OpenMP] Add semantic checks for is_device_ptr (#71255)
This patch adds the following semantic check for is_device_ptr ``` A list item that appears in an is_device_ptr clause must be a dummy argument that does not have the ALLOCATABLE, POINTER or VALUE attribute. ```
1 parent d9ccace commit d6b69a1

File tree

3 files changed

+47
-14
lines changed

3 files changed

+47
-14
lines changed

flang/include/flang/Semantics/tools.h

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -143,6 +143,9 @@ inline bool IsPointer(const Symbol &symbol) {
143143
inline bool IsAllocatable(const Symbol &symbol) {
144144
return symbol.attrs().test(Attr::ALLOCATABLE);
145145
}
146+
inline bool IsValue(const Symbol &symbol) {
147+
return symbol.attrs().test(Attr::VALUE);
148+
}
146149
// IsAllocatableOrObjectPointer() may be the better choice
147150
inline bool IsAllocatableOrPointer(const Symbol &symbol) {
148151
return IsPointer(symbol) || IsAllocatable(symbol);

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

Lines changed: 15 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -2864,18 +2864,21 @@ void OmpStructureChecker::Enter(const parser::OmpClause::IsDevicePtr &x) {
28642864
const auto &isDevicePtrClause{
28652865
std::get<parser::OmpClause::IsDevicePtr>(itr->second->u)};
28662866
const auto &isDevicePtrList{isDevicePtrClause.v};
2867-
std::list<parser::Name> isDevicePtrNameList;
2868-
for (const auto &ompObject : isDevicePtrList.v) {
2869-
if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
2870-
if (name->symbol) {
2871-
if (!(IsBuiltinCPtr(*(name->symbol)))) {
2872-
context_.Say(itr->second->source,
2873-
"Variable '%s' in IS_DEVICE_PTR clause must be of type C_PTR"_err_en_US,
2874-
name->ToString());
2875-
} else {
2876-
isDevicePtrNameList.push_back(*name);
2877-
}
2878-
}
2867+
SymbolSourceMap currSymbols;
2868+
GetSymbolsInObjectList(isDevicePtrList, currSymbols);
2869+
for (auto &[symbol, source] : currSymbols) {
2870+
if (!(IsBuiltinCPtr(*symbol))) {
2871+
context_.Say(itr->second->source,
2872+
"Variable '%s' in IS_DEVICE_PTR clause must be of type C_PTR"_err_en_US,
2873+
source.ToString());
2874+
} else if (!(IsDummy(*symbol))) {
2875+
context_.Say(itr->second->source,
2876+
"Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument"_err_en_US,
2877+
source.ToString());
2878+
} else if (IsAllocatableOrPointer(*symbol) || IsValue(*symbol)) {
2879+
context_.Say(itr->second->source,
2880+
"Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument that does not have the ALLOCATABLE, POINTER or VALUE attribute."_err_en_US,
2881+
source.ToString());
28792882
}
28802883
}
28812884
}

flang/test/Semantics/OpenMP/target01.f90

Lines changed: 29 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp
2-
2+
3+
subroutine foo(b)
34
use iso_c_binding
45
integer :: x,y
56
type(C_PTR) :: b
@@ -28,4 +29,30 @@
2829
y = y - 1
2930
!$omp end target
3031

31-
end
32+
end subroutine foo
33+
34+
subroutine bar(b1, b2, b3)
35+
use iso_c_binding
36+
integer :: y
37+
type(c_ptr) :: c
38+
type(c_ptr), allocatable :: b1
39+
type(c_ptr), pointer :: b2
40+
type(c_ptr), value :: b3
41+
42+
!ERROR: Variable 'c' in IS_DEVICE_PTR clause must be a dummy argument
43+
!$omp target is_device_ptr(c)
44+
y = y + 1
45+
!$omp end target
46+
!ERROR: Variable 'b1' in IS_DEVICE_PTR clause must be a dummy argument that does not have the ALLOCATABLE, POINTER or VALUE attribute.
47+
!$omp target is_device_ptr(b1)
48+
y = y + 1
49+
!$omp end target
50+
!ERROR: Variable 'b2' in IS_DEVICE_PTR clause must be a dummy argument that does not have the ALLOCATABLE, POINTER or VALUE attribute.
51+
!$omp target is_device_ptr(b2)
52+
y = y + 1
53+
!$omp end target
54+
!ERROR: Variable 'b3' in IS_DEVICE_PTR clause must be a dummy argument that does not have the ALLOCATABLE, POINTER or VALUE attribute.
55+
!$omp target is_device_ptr(b3)
56+
y = y + 1
57+
!$omp end target
58+
end subroutine bar

0 commit comments

Comments
 (0)