diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -351,6 +351,10 @@ 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 --- a/flang/lib/Semantics/compute-offsets.cpp +++ b/flang/lib/Semantics/compute-offsets.cpp @@ -156,7 +156,7 @@ 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 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -1677,7 +1677,9 @@ // 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 @@ } 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 --- /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 --- 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