[flang][OpenMP] Fix resolve common block in data-sharing clauses

The previous resolve only creates the host associated varaibles for
common block members, but does not replace the original objects with
the new created ones. Fix it and also compute the sizes and offsets
for the host common block members if they are host associated.

Reviewed By: kiranchandramohan

Differential Revision: https://reviews.llvm.org/D127214
This commit is contained in:
Peixin Qiao 2022-10-02 10:38:27 +08:00
parent d11e406e36
commit 4e43a14bdb
5 changed files with 42 additions and 15 deletions

View File

@ -351,6 +351,10 @@ public:
MutableSymbolVector &objects() { return objects_; }
const MutableSymbolVector &objects() const { return objects_; }
void add_object(Symbol &object) { objects_.emplace_back(object); }
void replace_object(Symbol &object, unsigned index) {
CHECK(index < (unsigned)objects_.size());
objects_[index] = object;
}
std::size_t alignment() const { return alignment_; }
void set_alignment(std::size_t alignment) { alignment_ = alignment; }

View File

@ -156,7 +156,7 @@ void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
Symbol &symbol{*object};
auto errorSite{
commonBlock.name().empty() ? symbol.name() : commonBlock.name()};
if (std::size_t padding{DoSymbol(symbol)}) {
if (std::size_t padding{DoSymbol(symbol.GetUltimate())}) {
context_.Say(errorSite,
"COMMON block /%s/ requires %zd bytes of padding before '%s' for alignment"_port_en_US,
commonBlock.name(), padding, symbol.name());

View File

@ -1677,7 +1677,9 @@ void OmpAttributeVisitor::ResolveOmpObject(
// 2.15.3 When a named common block appears in a list, it has the
// same meaning as if every explicit member of the common block
// appeared in the list
for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
auto &details{symbol->get<CommonBlockDetails>()};
unsigned index{0};
for (auto &object : details.objects()) {
if (auto *resolvedObject{
ResolveOmp(*object, ompFlag, currScope())}) {
if (dataCopyingAttributeFlags.test(ompFlag)) {
@ -1685,7 +1687,9 @@ void OmpAttributeVisitor::ResolveOmpObject(
} else {
AddToContextObjectWithDSA(*resolvedObject, ompFlag);
}
details.replace_object(*resolvedObject, index);
}
index++;
}
} else {
context_.Say(name.source, // 2.15.3

View File

@ -0,0 +1,18 @@
! RUN: %flang_fc1 -fopenmp -fdebug-dump-symbols %s | FileCheck %s
program main
!CHECK: a size=4 offset=0: ObjectEntity type: REAL(4)
!CHECK: b size=8 offset=4: ObjectEntity type: INTEGER(4) shape: 1_8:2_8
!CHECK: c size=4 offset=12: ObjectEntity type: REAL(4)
!CHECK: blk size=16 offset=0: CommonBlockDetails alignment=4: a b c
real :: a, c
integer :: b(2)
common /blk/ a, b, c
!$omp parallel private(/blk/)
!CHECK: OtherConstruct scope: size=0 alignment=1
!CHECK: a (OmpPrivate): HostAssoc
!CHECK: b (OmpPrivate): HostAssoc
!CHECK: c (OmpPrivate): HostAssoc
call sub(a, b, c)
!$omp end parallel
end program

View File

@ -5,44 +5,45 @@
program main
integer :: i, N = 10
integer, save :: x
common /blk/ y
integer, save :: x1, x2, x3, x4, x5, x6, x7, x8, x9
common /blk1/ y1, /blk2/ y2, /blk3/ y3, /blk4/ y4, /blk5/ y5
!$omp threadprivate(x, /blk/)
!$omp threadprivate(x1, x2, x3, x4, x5, x6, x7, x8, x9)
!$omp threadprivate(/blk1/, /blk2/, /blk3/, /blk4/, /blk5/)
!$omp parallel num_threads(x)
!$omp parallel num_threads(x1)
!$omp end parallel
!$omp single copyprivate(x, /blk/)
!$omp single copyprivate(x2, /blk1/)
!$omp end single
!$omp do schedule(static, x)
!$omp do schedule(static, x3)
do i = 1, N
y = x
y1 = x3
end do
!$omp end do
!$omp parallel copyin(x, /blk/)
!$omp parallel copyin(x4, /blk2/)
!$omp end parallel
!$omp parallel if(x > 1)
!$omp parallel if(x5 > 1)
!$omp end parallel
!$omp teams thread_limit(x)
!$omp teams thread_limit(x6)
!$omp end teams
!ERROR: A THREADPRIVATE variable cannot be in PRIVATE clause
!ERROR: A THREADPRIVATE variable cannot be in PRIVATE clause
!$omp parallel private(x, /blk/)
!$omp parallel private(x7, /blk3/)
!$omp end parallel
!ERROR: A THREADPRIVATE variable cannot be in FIRSTPRIVATE clause
!ERROR: A THREADPRIVATE variable cannot be in FIRSTPRIVATE clause
!$omp parallel firstprivate(x, /blk/)
!$omp parallel firstprivate(x8, /blk4/)
!$omp end parallel
!ERROR: A THREADPRIVATE variable cannot be in SHARED clause
!ERROR: A THREADPRIVATE variable cannot be in SHARED clause
!$omp parallel shared(x, /blk/)
!$omp parallel shared(x9, /blk5/)
!$omp end parallel
end