From 4e43a14bdbe1d3ae57701aa6d280fef46a6ea14b Mon Sep 17 00:00:00 2001 From: Peixin Qiao Date: Sun, 2 Oct 2022 10:38:27 +0800 Subject: [PATCH] [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 --- flang/include/flang/Semantics/symbol.h | 4 ++++ flang/lib/Semantics/compute-offsets.cpp | 2 +- flang/lib/Semantics/resolve-directives.cpp | 6 ++++- flang/test/Semantics/OpenMP/omp-common-block.f90 | 18 +++++++++++++++ .../test/Semantics/OpenMP/omp-threadprivate04.f90 | 27 +++++++++++----------- 5 files changed, 42 insertions(+), 15 deletions(-) create mode 100644 flang/test/Semantics/OpenMP/omp-common-block.f90 diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h index 0f89f96..829dee0 100644 --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -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; } diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp index 511c845..237b6b6 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 5f34061..16eacc5 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().objects()) { + auto &details{symbol->get()}; + 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 0000000..e1ddd12 --- /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 2612e9d..f523711 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 -- 2.7.4