[flang-commits] [flang] 4e43a14 - [flang][OpenMP] Fix resolve common block in data-sharing clauses
Peixin Qiao via flang-commits
flang-commits at lists.llvm.org
Sat Oct 1 19:41:30 PDT 2022
Author: Peixin Qiao
Date: 2022-10-02T10:38:27+08:00
New Revision: 4e43a14bdbe1d3ae57701aa6d280fef46a6ea14b
URL: https://github.com/llvm/llvm-project/commit/4e43a14bdbe1d3ae57701aa6d280fef46a6ea14b
DIFF: https://github.com/llvm/llvm-project/commit/4e43a14bdbe1d3ae57701aa6d280fef46a6ea14b.diff
LOG: [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
Added:
flang/test/Semantics/OpenMP/omp-common-block.f90
Modified:
flang/include/flang/Semantics/symbol.h
flang/lib/Semantics/compute-offsets.cpp
flang/lib/Semantics/resolve-directives.cpp
flang/test/Semantics/OpenMP/omp-threadprivate04.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 0f89f96564d20..829dee00c8241 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -351,6 +351,10 @@ class CommonBlockDetails : public WithBindName {
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; }
diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index 511c8453c47a7..237b6b6545d73 100644
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -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());
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 5f34061e9a3b6..16eacc5dff0a4 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -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
diff --git a/flang/test/Semantics/OpenMP/omp-common-block.f90 b/flang/test/Semantics/OpenMP/omp-common-block.f90
new file mode 100644
index 0000000000000..e1ddd120da857
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/omp-common-block.f90
@@ -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
diff --git a/flang/test/Semantics/OpenMP/omp-threadprivate04.f90 b/flang/test/Semantics/OpenMP/omp-threadprivate04.f90
index 2612e9da31ff5..f523711f41567 100644
--- a/flang/test/Semantics/OpenMP/omp-threadprivate04.f90
+++ b/flang/test/Semantics/OpenMP/omp-threadprivate04.f90
@@ -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
More information about the flang-commits
mailing list