[flang-commits] [flang] [flang][OpenACC] Reland data-clause designator path handling (PR #220781)
Andre Kuhlenschmidt via flang-commits
flang-commits at lists.llvm.org
Thu Oct 8 14:56:32 PDT 2026
https://github.com/akuhlens updated https://github.com/llvm/llvm-project/pull/220781
>From 991b837e92a2d3ab00c72cc2dcb38bb5d42ac432 Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Thu, 27 Aug 2026 14:22:18 -0700
Subject: [PATCH 01/10] Revert "[flang][openacc] revert stack starting with
#211606 (#218741)"
This reverts commit c359fd4979a3144d7fc54bd86198220d9d5f65e7.
---
.../include/flang/Evaluate/designator-path.h | 126 +++++
flang/include/flang/Semantics/tools.h | 14 +
flang/lib/Evaluate/CMakeLists.txt | 1 +
flang/lib/Evaluate/designator-path.cpp | 441 +++++++++++++++
flang/lib/Semantics/resolve-directives.cpp | 508 ++++++++++++++----
flang/lib/Semantics/tools.cpp | 187 +++++++
.../test/Lower/OpenACC/acc-copy-reduction.f90 | 31 ++
flang/test/Semantics/OpenACC/acc-common.f90 | 10 +
.../OpenACC/acc-component-ref-dsa.f90 | 92 +++-
.../Semantics/OpenACC/acc-copy-reduction.f90 | 77 +++
.../OpenACC/acc-data-action-overlap.f90 | 94 ++++
.../OpenACC/acc-dataclause-dedup.f90 | 166 +++++-
.../OpenACC/acc-default-none-arrays.f90 | 122 ++++-
.../OpenACC/acc-default-none-object-refs.f90 | 73 +++
flang/unittests/Evaluate/CMakeLists.txt | 8 +
flang/unittests/Evaluate/designator-path.cpp | 392 ++++++++++++++
16 files changed, 2201 insertions(+), 141 deletions(-)
create mode 100644 flang/include/flang/Evaluate/designator-path.h
create mode 100644 flang/lib/Evaluate/designator-path.cpp
create mode 100644 flang/test/Lower/OpenACC/acc-copy-reduction.f90
create mode 100644 flang/test/Semantics/OpenACC/acc-copy-reduction.f90
create mode 100644 flang/test/Semantics/OpenACC/acc-data-action-overlap.f90
create mode 100644 flang/test/Semantics/OpenACC/acc-default-none-object-refs.f90
create mode 100644 flang/unittests/Evaluate/designator-path.cpp
diff --git a/flang/include/flang/Evaluate/designator-path.h b/flang/include/flang/Evaluate/designator-path.h
new file mode 100644
index 00000000000000..d81334b75bcde2
--- /dev/null
+++ b/flang/include/flang/Evaluate/designator-path.h
@@ -0,0 +1,126 @@
+//===-- include/flang/Evaluate/designator-path.h ---------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_EVALUATE_DESIGNATOR_PATH_H_
+#define FORTRAN_EVALUATE_DESIGNATOR_PATH_H_
+
+#include "flang/Evaluate/expression.h"
+#include <cstdint>
+#include <optional>
+#include <string>
+#include <utility>
+#include <vector>
+
+namespace Fortran::evaluate {
+
+enum class DesignatorRelation {
+ Equal,
+ Contains,
+ ContainedBy,
+ Overlaps,
+ Disjoint,
+};
+
+struct DesignatorPath {
+ // A DesignatorPath represents a constrained prefix of a valid Fortran
+ // designator:
+ // - an optional NamedEntity base, and
+ // - zero or more suffix parts.
+ //
+ // The optional base distinguishes the named entity from subsequent part
+ // references. Each suffix part first applies optional subscripts to the
+ // current entity and then optionally selects a component symbol. An empty
+ // subscript list means there is no explicit subscript selector on this part;
+ // a full slice `(:)` is represented as a single Triplet subscript with no
+ // lower or upper bound and stride one. This can later grow a final optional
+ // variant for terminal designator pieces that are not part refs, such as
+ // complex parts, character substrings, or coarray references, while still
+ // preserving a valid designator shape.
+ struct Part {
+ std::vector<Subscript> subscripts;
+ const Symbol *symbol{nullptr};
+ bool operator==(const Part &that) const {
+ return subscripts == that.subscripts && symbol == that.symbol;
+ }
+ };
+
+ static std::optional<DesignatorPath> Get(
+ const std::optional<Expr<SomeType>> &);
+ DesignatorRelation Compare(const DesignatorPath &) const;
+ bool MayContain(const DesignatorPath &) const;
+ std::string AsFortran() const;
+ llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
+ void SetBase(NamedEntity);
+ void AddComponent(const Symbol &);
+ void AddSubscripts(std::vector<Subscript>);
+ const std::optional<NamedEntity> &Base() const { return base; }
+ const std::vector<Part> &Parts() const { return parts; }
+ bool empty() const { return !base && parts.empty(); }
+ bool HasBaseOnly() const { return base && parts.empty(); }
+ bool operator==(const DesignatorPath &that) const {
+ return base == that.base && parts == that.parts;
+ }
+
+ struct ConstantSubscriptRange {
+ std::int64_t lower;
+ std::int64_t upper;
+ };
+
+ static std::optional<ConstantSubscriptRange> GetConstantSubscriptRange(
+ const Subscript &);
+ static bool IsFullTriplet(const Triplet &);
+ static DesignatorRelation CompareSubscripts(
+ const Subscript &, const Subscript &);
+ static DesignatorRelation CompareSubscriptLists(
+ const std::vector<Subscript> &, const std::vector<Subscript> &);
+ static DesignatorRelation CompareParts(const Part &, const Part &);
+ static DesignatorRelation CombineRelations(
+ bool contains, bool containedBy, bool overlaps);
+ static bool SubscriptMayContain(const Subscript &, const Subscript &);
+ static bool SubscriptListMayContain(
+ const std::vector<Subscript> &, const std::vector<Subscript> &);
+ static bool PartMayContain(const Part &, const Part &);
+
+private:
+ void AddDataRef(const DataRef &);
+ void AddComponent(const Component &);
+ void AddNamedEntity(const NamedEntity &);
+ void AddArrayRef(const ArrayRef &);
+ void AddCoarrayRef(const CoarrayRef &);
+
+ std::optional<NamedEntity> base;
+ std::vector<Part> parts;
+};
+
+template <typename A> class DesignatorPathMap {
+public:
+ struct Entry {
+ DesignatorPath path;
+ A value;
+ };
+ using iterator = typename std::vector<Entry>::iterator;
+ using const_iterator = typename std::vector<Entry>::const_iterator;
+
+ iterator begin() { return entries_.begin(); }
+ iterator end() { return entries_.end(); }
+ const_iterator begin() const { return entries_.begin(); }
+ const_iterator end() const { return entries_.end(); }
+ bool empty() const { return entries_.empty(); }
+ void clear() { entries_.clear(); }
+ iterator erase(iterator iter) { return entries_.erase(iter); }
+ void push_back(DesignatorPath path, A value) {
+ entries_.push_back({std::move(path), std::move(value)});
+ }
+
+private:
+ std::vector<Entry> entries_;
+};
+
+} // namespace Fortran::evaluate
+
+#endif // FORTRAN_EVALUATE_DESIGNATOR_PATH_H_
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index d91a7d11a38c94..94a1ac0fd31054 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -13,6 +13,7 @@
// canonically for use in semantic checking.
#include "flang/Common/visit.h"
+#include "flang/Evaluate/designator-path.h"
#include "flang/Evaluate/expression.h"
#include "flang/Evaluate/shape.h"
#include "flang/Evaluate/type.h"
@@ -207,6 +208,19 @@ bool IsAssumedLengthCharacter(const Symbol &);
bool IsExternal(const Symbol &);
bool IsModuleProcedure(const Symbol &);
bool HasCoarray(const parser::Expr &);
+
+// Builds an evaluate::DesignatorPath (the structural prefix of a designator
+// used by OpenACC data-sharing analysis) from the parse tree. It uses the
+// already-resolved base symbol and component structure, and analyzes and folds
+// subscript expressions. Returns std::nullopt when the designator cannot be
+// represented (e.g. an unresolved name or a non-integer/erroneous subscript).
+std::optional<evaluate::DesignatorPath> GetDesignatorPath(
+ SemanticsContext &, const parser::Designator &);
+std::optional<evaluate::DesignatorPath> GetDesignatorPath(
+ SemanticsContext &, const parser::FunctionReference &);
+std::optional<evaluate::DesignatorPath> GetDesignatorPath(
+ SemanticsContext &, const parser::ArrayElement &);
+
bool IsAssumedType(const Symbol &);
bool IsEnumerationType(const Symbol &);
bool IsEnumerationType(const DerivedTypeSpec &);
diff --git a/flang/lib/Evaluate/CMakeLists.txt b/flang/lib/Evaluate/CMakeLists.txt
index 472ecb6d8d079b..31b9269aaf8692 100644
--- a/flang/lib/Evaluate/CMakeLists.txt
+++ b/flang/lib/Evaluate/CMakeLists.txt
@@ -35,6 +35,7 @@ add_flang_library(FortranEvaluate
common.cpp
complex.cpp
constant.cpp
+ designator-path.cpp
expression.cpp
fold.cpp
fold-character.cpp
diff --git a/flang/lib/Evaluate/designator-path.cpp b/flang/lib/Evaluate/designator-path.cpp
new file mode 100644
index 00000000000000..8c498cf010b4f8
--- /dev/null
+++ b/flang/lib/Evaluate/designator-path.cpp
@@ -0,0 +1,441 @@
+//===-- lib/Evaluate/designator-path.cpp ---------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Evaluate/designator-path.h"
+#include "flang/Evaluate/fold.h"
+#include "flang/Evaluate/tools.h"
+#include "llvm/Support/ErrorHandling.h"
+#include "llvm/Support/raw_ostream.h"
+
+namespace Fortran::evaluate {
+
+static DesignatorRelation ComparePartSymbols(const Symbol *x, const Symbol *y) {
+ if (x == y) {
+ return DesignatorRelation::Equal;
+ }
+ if (!x) {
+ return DesignatorRelation::Contains;
+ }
+ if (!y) {
+ return DesignatorRelation::ContainedBy;
+ }
+ return DesignatorRelation::Disjoint;
+}
+
+static bool IsFullSubscriptList(const std::vector<Subscript> &subscripts) {
+ if (subscripts.empty()) {
+ return false;
+ }
+ for (const Subscript &subscript : subscripts) {
+ const auto *triplet{std::get_if<Triplet>(&subscript.u)};
+ if (!triplet || !DesignatorPath::IsFullTriplet(*triplet)) {
+ return false;
+ }
+ }
+ return true;
+}
+
+static bool IsFullSlicePart(const DesignatorPath::Part &part) {
+ return !part.symbol && IsFullSubscriptList(part.subscripts);
+}
+
+static bool AreAllFullSliceParts(
+ const std::vector<DesignatorPath::Part> &parts, std::size_t first) {
+ for (std::size_t i{first}; i < parts.size(); ++i) {
+ if (!IsFullSlicePart(parts[i])) {
+ return false;
+ }
+ }
+ return true;
+}
+
+std::optional<DesignatorPath::ConstantSubscriptRange>
+DesignatorPath::GetConstantSubscriptRange(const Subscript &subscript) {
+ // Surface syntax `x(i)` maps to a scalar Subscript that holds the integer
+ // expression `i`, not a Triplet.
+ if (const auto *expr{
+ std::get_if<IndirectSubscriptIntegerExpr>(&subscript.u)}) {
+ if (auto value{ToInt64(expr->value())}) {
+ return ConstantSubscriptRange{*value, *value};
+ }
+ } else if (const auto *triplet{std::get_if<Triplet>(&subscript.u)}) {
+ // Surface syntax `x(l:u)` maps to a Triplet with explicit lower and upper
+ // bounds and an implicit stride of one. Syntax like `x(:u)`, `x(l:)`, and
+ // `x(:)` maps to missing lower and/or upper bounds, so it is not a
+ // constant finite range here.
+ const auto *lowerExpr{triplet->GetLower()};
+ const auto *upperExpr{triplet->GetUpper()};
+ auto lower{lowerExpr ? ToInt64(*lowerExpr) : std::nullopt};
+ auto upper{upperExpr ? ToInt64(*upperExpr) : std::nullopt};
+ // Surface syntax `x(l:u:s)` maps to the same Triplet representation with a
+ // non-optional stride expression.
+ auto stride{ToInt64(triplet->GetStride())};
+ if (lower && upper && stride && *stride == 1) {
+ return ConstantSubscriptRange{*lower, *upper};
+ }
+ }
+ return std::nullopt;
+}
+
+bool DesignatorPath::IsFullTriplet(const Triplet &triplet) {
+ // Surface syntax `x(:)` maps to a Triplet with no lower or upper bound and
+ // an implicit stride of one.
+ auto stride{ToInt64(triplet.GetStride())};
+ return !triplet.GetLower() && !triplet.GetUpper() && stride && *stride == 1;
+}
+
+DesignatorRelation DesignatorPath::CompareSubscripts(
+ const Subscript &x, const Subscript &y) {
+ if (x == y) {
+ return DesignatorRelation::Equal;
+ }
+ const auto *xTriplet{std::get_if<Triplet>(&x.u)};
+ const auto *yTriplet{std::get_if<Triplet>(&y.u)};
+ if (xTriplet && IsFullTriplet(*xTriplet)) {
+ if (yTriplet && IsFullTriplet(*yTriplet)) {
+ return DesignatorRelation::Equal;
+ }
+ return DesignatorRelation::Contains;
+ }
+ if (yTriplet && IsFullTriplet(*yTriplet)) {
+ return DesignatorRelation::ContainedBy;
+ }
+ auto xRange{GetConstantSubscriptRange(x)};
+ auto yRange{GetConstantSubscriptRange(y)};
+ if (!xRange || !yRange) {
+ // Nonconstant selectors and constant triplets with non-unit strides cannot
+ // be compared precisely, so treat them as disjoint for now. Constant
+ // triplets could be made more precise by expanding them into index sets.
+ return DesignatorRelation::Disjoint;
+ }
+ if (xRange->upper < yRange->lower || yRange->upper < xRange->lower) {
+ return DesignatorRelation::Disjoint;
+ }
+ if (xRange->lower == yRange->lower && xRange->upper == yRange->upper) {
+ return DesignatorRelation::Equal;
+ }
+ if (xRange->lower <= yRange->lower && xRange->upper >= yRange->upper) {
+ return DesignatorRelation::Contains;
+ }
+ if (yRange->lower <= xRange->lower && yRange->upper >= xRange->upper) {
+ return DesignatorRelation::ContainedBy;
+ }
+ return DesignatorRelation::Overlaps;
+}
+
+bool DesignatorPath::SubscriptMayContain(
+ const Subscript &x, const Subscript &y) {
+ if (x == y) {
+ return true;
+ }
+ const auto *xTriplet{std::get_if<Triplet>(&x.u)};
+ const auto *yTriplet{std::get_if<Triplet>(&y.u)};
+ if (xTriplet && IsFullTriplet(*xTriplet)) {
+ return true;
+ }
+ if (yTriplet && IsFullTriplet(*yTriplet)) {
+ return false;
+ }
+ if (!xTriplet && yTriplet) {
+ return false;
+ }
+ auto xRange{GetConstantSubscriptRange(x)};
+ auto yRange{GetConstantSubscriptRange(y)};
+ if (xRange && yRange) {
+ return xRange->lower <= yRange->lower && xRange->upper >= yRange->upper;
+ }
+ if (xTriplet) {
+ return true;
+ }
+ return !ToInt64(std::get<IndirectSubscriptIntegerExpr>(x.u).value()) ||
+ !ToInt64(std::get<IndirectSubscriptIntegerExpr>(y.u).value());
+}
+
+bool DesignatorPath::SubscriptListMayContain(
+ const std::vector<Subscript> &x, const std::vector<Subscript> &y) {
+ if (x.empty()) {
+ return true;
+ }
+ if (IsFullSubscriptList(x)) {
+ return y.empty() || x.size() == y.size();
+ }
+ if (y.empty()) {
+ return false;
+ }
+ if (x.size() != y.size()) {
+ return false;
+ }
+ for (std::size_t i{0}; i < x.size(); ++i) {
+ if (!SubscriptMayContain(x[i], y[i])) {
+ return false;
+ }
+ }
+ return true;
+}
+
+bool DesignatorPath::PartMayContain(const Part &x, const Part &y) {
+ return SubscriptListMayContain(x.subscripts, y.subscripts) &&
+ (!x.symbol || x.symbol == y.symbol);
+}
+
+DesignatorRelation DesignatorPath::CombineRelations(
+ bool contains, bool containedBy, bool overlaps) {
+ if (overlaps || (contains && containedBy)) {
+ return DesignatorRelation::Overlaps;
+ }
+ if (contains) {
+ return DesignatorRelation::Contains;
+ }
+ if (containedBy) {
+ return DesignatorRelation::ContainedBy;
+ }
+ return DesignatorRelation::Equal;
+}
+
+DesignatorRelation DesignatorPath::CompareSubscriptLists(
+ const std::vector<Subscript> &x, const std::vector<Subscript> &y) {
+ if (x.empty() && y.empty()) {
+ return DesignatorRelation::Equal;
+ }
+ if (x.empty()) {
+ return IsFullSubscriptList(y) ? DesignatorRelation::Equal
+ : DesignatorRelation::Contains;
+ }
+ if (y.empty()) {
+ return IsFullSubscriptList(x) ? DesignatorRelation::Equal
+ : DesignatorRelation::ContainedBy;
+ }
+ const bool xFull{IsFullSubscriptList(x)};
+ const bool yFull{IsFullSubscriptList(y)};
+ if (xFull || yFull) {
+ if (x.size() != y.size()) {
+ return DesignatorRelation::Disjoint;
+ }
+ if (xFull && yFull) {
+ return DesignatorRelation::Equal;
+ }
+ return xFull ? DesignatorRelation::Contains
+ : DesignatorRelation::ContainedBy;
+ }
+ if (x.size() != y.size()) {
+ return DesignatorRelation::Disjoint;
+ }
+ bool contains{false};
+ bool containedBy{false};
+ bool overlaps{false};
+ for (std::size_t i{0}; i < x.size(); ++i) {
+ switch (CompareSubscripts(x[i], y[i])) {
+ case DesignatorRelation::Equal:
+ break;
+ case DesignatorRelation::Contains:
+ contains = true;
+ break;
+ case DesignatorRelation::ContainedBy:
+ containedBy = true;
+ break;
+ case DesignatorRelation::Overlaps:
+ overlaps = true;
+ break;
+ case DesignatorRelation::Disjoint:
+ return DesignatorRelation::Disjoint;
+ }
+ }
+ return CombineRelations(contains, containedBy, overlaps);
+}
+
+DesignatorRelation DesignatorPath::CompareParts(const Part &x, const Part &y) {
+ DesignatorRelation subscriptRelation{
+ CompareSubscriptLists(x.subscripts, y.subscripts)};
+ if (subscriptRelation == DesignatorRelation::Disjoint) {
+ return DesignatorRelation::Disjoint;
+ }
+ DesignatorRelation symbolRelation{ComparePartSymbols(x.symbol, y.symbol)};
+ if (symbolRelation == DesignatorRelation::Disjoint) {
+ return DesignatorRelation::Disjoint;
+ }
+ bool contains{subscriptRelation == DesignatorRelation::Contains ||
+ symbolRelation == DesignatorRelation::Contains};
+ bool containedBy{subscriptRelation == DesignatorRelation::ContainedBy ||
+ symbolRelation == DesignatorRelation::ContainedBy};
+ bool overlaps{subscriptRelation == DesignatorRelation::Overlaps ||
+ symbolRelation == DesignatorRelation::Overlaps};
+ return CombineRelations(contains, containedBy, overlaps);
+}
+
+DesignatorRelation DesignatorPath::Compare(const DesignatorPath &that) const {
+ if (*this == that) {
+ return DesignatorRelation::Equal;
+ }
+ if (empty() || that.empty()) {
+ return DesignatorRelation::Disjoint;
+ }
+ if (base || that.base) {
+ if (!base || !that.base || !(*base == *that.base)) {
+ return DesignatorRelation::Disjoint;
+ }
+ }
+ if (parts.empty() || that.parts.empty()) {
+ if ((!parts.empty() && AreAllFullSliceParts(parts, 0)) ||
+ (!that.parts.empty() && AreAllFullSliceParts(that.parts, 0))) {
+ return DesignatorRelation::Equal;
+ }
+ return parts.empty() ? DesignatorRelation::Contains
+ : DesignatorRelation::ContainedBy;
+ }
+ bool contains{false};
+ bool containedBy{false};
+ bool overlaps{false};
+ const std::size_t commonSize{
+ parts.size() < that.parts.size() ? parts.size() : that.parts.size()};
+ for (std::size_t i{0}; i < commonSize; ++i) {
+ switch (CompareParts(parts[i], that.parts[i])) {
+ case DesignatorRelation::Equal:
+ break;
+ case DesignatorRelation::Contains:
+ contains = true;
+ break;
+ case DesignatorRelation::ContainedBy:
+ containedBy = true;
+ break;
+ case DesignatorRelation::Overlaps:
+ overlaps = true;
+ break;
+ case DesignatorRelation::Disjoint:
+ return DesignatorRelation::Disjoint;
+ }
+ }
+ if (parts.size() < that.parts.size()) {
+ if (!AreAllFullSliceParts(that.parts, parts.size())) {
+ contains = true;
+ }
+ } else if (that.parts.size() < parts.size()) {
+ if (!AreAllFullSliceParts(parts, that.parts.size())) {
+ containedBy = true;
+ }
+ }
+ return CombineRelations(contains, containedBy, overlaps);
+}
+
+bool DesignatorPath::MayContain(const DesignatorPath &that) const {
+ if (*this == that || empty()) {
+ return true;
+ }
+ if (base || that.base) {
+ if (!base || !that.base || !(*base == *that.base)) {
+ return false;
+ }
+ }
+ if (that.parts.empty()) {
+ return AreAllFullSliceParts(parts, 0);
+ }
+ if (parts.size() > that.parts.size() &&
+ !AreAllFullSliceParts(parts, that.parts.size())) {
+ return false;
+ }
+ if (parts.empty()) {
+ return true;
+ }
+ for (std::size_t i{0}; i < parts.size(); ++i) {
+ if (i >= that.parts.size()) {
+ return AreAllFullSliceParts(parts, i);
+ }
+ if (!PartMayContain(parts[i], that.parts[i])) {
+ return false;
+ }
+ }
+ return true;
+}
+
+std::string DesignatorPath::AsFortran() const {
+ std::string result;
+ llvm::raw_string_ostream stream{result};
+ AsFortran(stream);
+ return result;
+}
+
+llvm::raw_ostream &DesignatorPath::AsFortran(llvm::raw_ostream &o) const {
+ if (!base) {
+ return o;
+ }
+ base->AsFortran(o);
+ for (const Part &part : parts) {
+ if (!part.subscripts.empty()) {
+ char separator{'('};
+ for (const Subscript &subscript : part.subscripts) {
+ subscript.AsFortran(o << separator);
+ separator = ',';
+ }
+ o << ')';
+ }
+ if (part.symbol) {
+ o << '%' << part.symbol->name();
+ }
+ }
+ return o;
+}
+
+void DesignatorPath::SetBase(NamedEntity entity) { base = std::move(entity); }
+
+void DesignatorPath::AddComponent(const Symbol &symbol) {
+ if (!parts.empty() && !parts.back().symbol) {
+ parts.back().symbol = &symbol;
+ } else {
+ parts.push_back({{}, &symbol});
+ }
+}
+
+void DesignatorPath::AddSubscripts(std::vector<Subscript> subscripts) {
+ parts.push_back({std::move(subscripts), nullptr});
+}
+
+void DesignatorPath::AddComponent(const Component &component) {
+ AddDataRef(component.base());
+ AddComponent(*component.symbol());
+}
+
+void DesignatorPath::AddNamedEntity(const NamedEntity &entity) {
+ if (const auto *symbol{entity.UnwrapSymbolRef()}) {
+ SetBase(NamedEntity{symbol->get()});
+ } else if (const auto *component{entity.UnwrapComponent()}) {
+ AddComponent(*component);
+ }
+}
+
+void DesignatorPath::AddArrayRef(const ArrayRef &arrayRef) {
+ AddNamedEntity(arrayRef.base());
+ AddSubscripts(arrayRef.subscript());
+}
+
+void DesignatorPath::AddCoarrayRef(const CoarrayRef &coarrayRef) {
+ AddDataRef(coarrayRef.base());
+}
+
+void DesignatorPath::AddDataRef(const DataRef &dataRef) {
+ common::visit(
+ common::visitors{
+ [&](SymbolRef symbol) { SetBase(NamedEntity{symbol.get()}); },
+ [&](const Component &component) { AddComponent(component); },
+ [&](const ArrayRef &arrayRef) { AddArrayRef(arrayRef); },
+ [&](const CoarrayRef &coarrayRef) { AddCoarrayRef(coarrayRef); },
+ },
+ dataRef.u);
+}
+
+std::optional<DesignatorPath> DesignatorPath::Get(
+ const std::optional<Expr<SomeType>> &expr) {
+ if (std::optional<DataRef> dataRef{ExtractDataRef(expr)}) {
+ DesignatorPath path;
+ path.AddDataRef(*dataRef);
+ if (!path.empty()) {
+ return path;
+ }
+ }
+ return std::nullopt;
+}
+
+} // namespace Fortran::evaluate
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index d707ff836b146b..3f4536240b5007 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -12,6 +12,7 @@
#include "check-omp-structure.h"
#include "resolve-names-utils.h"
#include "flang/Common/idioms.h"
+#include "flang/Evaluate/designator-path.h"
#include "flang/Evaluate/fold.h"
#include "flang/Evaluate/tools.h"
#include "flang/Evaluate/type.h"
@@ -32,9 +33,17 @@
#include "llvm/Support/Debug.h"
#include <list>
#include <map>
+#include <optional>
+#include <string>
+#include <utility>
namespace Fortran::semantics {
+using evaluate::DesignatorPath;
+using evaluate::DesignatorPathMap;
+using evaluate::DesignatorRelation;
+using evaluate::NamedEntity;
+
template <typename T> class DirectiveAttributeVisitor {
public:
explicit DirectiveAttributeVisitor(SemanticsContext &context)
@@ -109,14 +118,6 @@ template <typename T> class DirectiveAttributeVisitor {
bool IsObjectWithDSA(const Symbol &symbol) {
return GetContext().FindSymbolWithDSA(symbol).has_value();
}
- bool IsObjectWithVisibleDSA(const Symbol &symbol) {
- for (std::size_t i{dirContext_.size()}; i != 0; i--) {
- if (dirContext_[i - 1].FindSymbolWithDSA(symbol).has_value()) {
- return true;
- }
- }
- return false;
- }
bool WithinConstruct() {
return !dirContext_.empty() && GetContext().withinConstruct;
@@ -171,25 +172,68 @@ template <typename T> class DirectiveAttributeVisitor {
std::vector<DirContext> dirContext_; // used as a stack
};
-class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
+class AccAttributeVisitor {
+private:
+ struct AccDataSharingEntry {
+ Symbol::Flag flag;
+ const parser::AccObject *occurrence{nullptr};
+ };
+
+ struct AccDirContext {
+ AccDirContext(
+ const parser::CharBlock &source, llvm::acc::Directive d, Scope &s)
+ : directiveSource{source}, directive{d}, scope{s} {}
+ parser::CharBlock directiveSource;
+ llvm::acc::Directive directive;
+ Scope &scope;
+ Symbol::Flag defaultDSA{Symbol::Flag::AccShared};
+ DesignatorPathMap<AccDataSharingEntry> objectsWithDSA;
+ bool withinConstruct{false};
+ std::int64_t associatedLoopLevel{0};
+ };
+
+ AccDirContext &GetContext() {
+ CHECK(!dirContext_.empty());
+ return dirContext_.back();
+ }
+ const AccDirContext &GetContext() const {
+ CHECK(!dirContext_.empty());
+ return dirContext_.back();
+ }
+ Scope &currScope() { return GetContext().scope; }
+ bool WithinConstruct() const {
+ return !dirContext_.empty() && GetContext().withinConstruct;
+ }
+ void SetContextDefaultDSA(Symbol::Flag flag) {
+ GetContext().defaultDSA = flag;
+ }
+ void SetContextAssociatedLoopLevel(std::int64_t level) {
+ GetContext().associatedLoopLevel = level;
+ }
+ std::tuple<const parser::Name *, const parser::ScalarExpr *,
+ const parser::ScalarExpr *, const parser::ScalarExpr *>
+ GetLoopBounds(const parser::DoConstruct &);
+ static const parser::DoConstruct *GetDoConstructIf(
+ const parser::ExecutionPartConstruct &);
+
public:
explicit AccAttributeVisitor(SemanticsContext &context, Scope *topScope)
- : DirectiveAttributeVisitor(context), topScope_(topScope) {}
+ : context_{context}, topScope_(topScope) {}
template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
template <typename A> bool Pre(const A &) { return true; }
template <typename A> void Post(const A &) {}
bool Pre(const parser::OpenACCBlockConstruct &);
- void Post(const parser::OpenACCBlockConstruct &) { PopContext(); }
+ void Post(const parser::OpenACCBlockConstruct &) { PopAccContext(); }
bool Pre(const parser::OpenACCCombinedConstruct &);
- void Post(const parser::OpenACCCombinedConstruct &) { PopContext(); }
+ void Post(const parser::OpenACCCombinedConstruct &) { PopAccContext(); }
void Post(const parser::AccBeginCombinedDirective &) {
GetContext().withinConstruct = true;
}
bool Pre(const parser::OpenACCDeclarativeConstruct &);
- void Post(const parser::OpenACCDeclarativeConstruct &) { PopContext(); }
+ void Post(const parser::OpenACCDeclarativeConstruct &) { PopAccContext(); }
void Post(const parser::AccDeclarativeDirective &) {
GetContext().withinConstruct = true;
@@ -204,7 +248,7 @@ class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
}
bool Pre(const parser::OpenACCLoopConstruct &);
- void Post(const parser::OpenACCLoopConstruct &) { PopContext(); }
+ void Post(const parser::OpenACCLoopConstruct &) { PopAccContext(); }
void Post(const parser::AccLoopDirective &) {
GetContext().withinConstruct = true;
}
@@ -213,27 +257,28 @@ class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
template <typename A>
bool Pre(const parser::LoopBounds<parser::ScalarName, A> &x) {
if (!dirContext_.empty() && GetContext().withinConstruct) {
- if (auto *symbol{ResolveAcc(
- x.Name().thing, Symbol::Flag::AccPrivate, currScope())}) {
- AddToContextObjectWithDSA(*symbol, Symbol::Flag::AccPrivate);
+ if (auto *symbol{DeclareOrMarkOtherAccessEntity(
+ x.Name().thing, Symbol::Flag::AccPrivate)}) {
+ CheckClauseConsistencyInCurrentConstruct(x.Name().thing,
+ Symbol::Flag::AccPrivate, MakeBaseDesignatorPath(*symbol));
}
}
return true;
}
bool Pre(const parser::OpenACCStandaloneConstruct &);
- void Post(const parser::OpenACCStandaloneConstruct &) { PopContext(); }
+ void Post(const parser::OpenACCStandaloneConstruct &) { PopAccContext(); }
void Post(const parser::AccStandaloneDirective &) {
GetContext().withinConstruct = true;
}
bool Pre(const parser::OpenACCWaitConstruct &);
- void Post(const parser::OpenACCWaitConstruct &) { PopContext(); }
+ void Post(const parser::OpenACCWaitConstruct &) { PopAccContext(); }
bool Pre(const parser::OpenACCAtomicConstruct &);
- void Post(const parser::OpenACCAtomicConstruct &) { PopContext(); }
+ void Post(const parser::OpenACCAtomicConstruct &) { PopAccContext(); }
bool Pre(const parser::OpenACCCacheConstruct &);
- void Post(const parser::OpenACCCacheConstruct &) { PopContext(); }
+ void Post(const parser::OpenACCCacheConstruct &) { PopAccContext(); }
void Post(const parser::AccDefaultClause &);
@@ -344,9 +389,29 @@ class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
return false;
}
+ bool Pre(const parser::Expr &);
+ void Post(const parser::Expr &);
+ bool Pre(const parser::Variable &);
+ void Post(const parser::Variable &);
+ bool Pre(const parser::ArrayElement &);
+ void Post(const parser::ArrayElement &);
void Post(const parser::Name &);
private:
+ void PushAccContext(const parser::CharBlock &, llvm::acc::Directive, Scope &);
+ void PushAccContext(const parser::CharBlock &, llvm::acc::Directive);
+ void PopAccContext();
+ static DesignatorPath MakeBaseDesignatorPath(const Symbol &);
+ bool IsObjectWithVisibleDSA(const DesignatorPath &) const;
+ void AdjustAccSymbolReference(const parser::Name &);
+ void enterExpressionLikeContext() { ++expressionLikeDepthCount_; }
+ void exitExpressionLikeContext() { --expressionLikeDepthCount_; }
+ bool inExpressionLikeContext() const {
+ return expressionLikeDepthCount_ != 0;
+ }
+ void CheckAccDefaultNoneReference(const parser::Name &, DesignatorPath);
+ template <typename A> void CheckAccDefaultNoneReferenceIn(const A &);
+
std::int64_t GetAssociatedLoopLevelFromClauses(const parser::AccClauseList &);
bool HasForceCollapseModifier(const parser::AccClauseList &);
@@ -370,15 +435,21 @@ class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
void CheckAssociatedLoop(const parser::DoConstruct &, bool forceCollapsed);
void ResolveAccObjectList(const parser::AccObjectList &, Symbol::Flag);
void ResolveAccObject(const parser::AccObject &, Symbol::Flag);
- Symbol *ResolveAcc(const parser::Name &, Symbol::Flag, Scope &);
- Symbol *ResolveAcc(Symbol &, Symbol::Flag, Scope &);
+ // Called by ResolveAccObject() for a non-bare designator. Returns true only
+ // when a resolved unsupported designator was diagnosed; the caller must then
+ // stop processing that object.
+ bool DiagnoseUnsupportedAccClauseDesignator(const parser::Designator &);
Symbol *ResolveName(const parser::Name &);
Symbol *ResolveFctName(const parser::Name &);
Symbol *ResolveAccCommonBlockName(const parser::Name *);
Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
- void CheckMultipleAppearances(const parser::Name &, const Symbol &,
- Symbol::Flag, const parser::AccObject *occurrence = nullptr,
+ // Called for explicit clause objects and implicit loop privatization.
+ // Returns true iff the occurrence remains effective in the current OpenACC
+ // construct; common-block processing uses false to stop expanding the block.
+ bool CheckClauseConsistencyInCurrentConstruct(const parser::Name &,
+ Symbol::Flag, DesignatorPath,
+ const parser::AccObject *occurrence = nullptr,
bool warnSameKindDuplicate = true);
void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList);
void DoNotAllowAssumedSizedArray(const parser::AccObjectList &objectList);
@@ -394,6 +465,13 @@ class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
void ClearUseDeviceObjects() { useDeviceObjects_.clear(); }
UnorderedSymbolSet useDeviceObjects_;
+ SemanticsContext &context_;
+ std::vector<AccDirContext> dirContext_; // used as a stack
+ // Expr, Variable, and ArrayElement visitor nodes have path-aware post
+ // handlers. A Name outside those expression-like contexts is a whole-object
+ // reference that needs DEFAULT(NONE) checking directly (e.g. ALLOCATE,
+ // DEALLOCATE, NULLIFY, or the pointer in a pointer assignment).
+ int expressionLikeDepthCount_{0};
Scope *topScope_;
};
@@ -1155,6 +1233,31 @@ Symbol *DirectiveAttributeVisitor<T>::DeclareAccessEntity(
}
}
+std::tuple<const parser::Name *, const parser::ScalarExpr *,
+ const parser::ScalarExpr *, const parser::ScalarExpr *>
+AccAttributeVisitor::GetLoopBounds(const parser::DoConstruct &x) {
+ using Bounds = parser::LoopControl::Bounds;
+ if (x.GetLoopControl()) {
+ if (const Bounds *b{std::get_if<Bounds>(&x.GetLoopControl()->u)}) {
+ const auto &step = b->Step();
+ return {&b->Name().thing, &b->Lower(), &b->Upper(),
+ step.has_value() ? &step.value() : nullptr};
+ }
+ } else {
+ context_
+ .Say(std::get<parser::Statement<parser::NonLabelDoStmt>>(x.t).source,
+ "Loop control is not present in the DO LOOP"_err_en_US)
+ .Attach(GetContext().directiveSource,
+ "associated with the enclosing LOOP construct"_en_US);
+ }
+ return {nullptr, nullptr, nullptr, nullptr};
+}
+
+const parser::DoConstruct *AccAttributeVisitor::GetDoConstructIf(
+ const parser::ExecutionPartConstruct &x) {
+ return parser::Unwrap<parser::DoConstruct>(x);
+}
+
bool AccAttributeVisitor::Pre(const parser::OpenACCBlockConstruct &x) {
const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};
@@ -1164,12 +1267,11 @@ bool AccAttributeVisitor::Pre(const parser::OpenACCBlockConstruct &x) {
case llvm::acc::Directive::ACCD_kernels:
case llvm::acc::Directive::ACCD_parallel:
case llvm::acc::Directive::ACCD_serial:
- PushContext(blockDir.source, blockDir.v);
+ PushAccContext(blockDir.source, blockDir.v);
break;
default:
break;
}
- ClearDataSharingAttributeObjects();
ClearUseDeviceObjects();
return true;
}
@@ -1179,9 +1281,8 @@ bool AccAttributeVisitor::Pre(const parser::OpenACCDeclarativeConstruct &x) {
std::get_if<parser::OpenACCStandaloneDeclarativeConstruct>(&x.u)}) {
const auto &declDir{
std::get<parser::AccDeclarativeDirective>(declConstruct->t)};
- PushContext(declDir.source, llvm::acc::Directive::ACCD_declare);
+ PushAccContext(declDir.source, llvm::acc::Directive::ACCD_declare);
}
- ClearDataSharingAttributeObjects();
return true;
}
@@ -1251,9 +1352,8 @@ bool AccAttributeVisitor::Pre(const parser::OpenACCLoopConstruct &x) {
const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
const auto &clauseList{std::get<parser::AccClauseList>(beginDir.t)};
if (loopDir.v == llvm::acc::Directive::ACCD_loop) {
- PushContext(loopDir.source, loopDir.v);
+ PushAccContext(loopDir.source, loopDir.v);
}
- ClearDataSharingAttributeObjects();
SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
CheckAssociatedLoop(*outer, HasForceCollapseModifier(clauseList));
@@ -1269,12 +1369,11 @@ bool AccAttributeVisitor::Pre(const parser::OpenACCStandaloneConstruct &x) {
case llvm::acc::Directive::ACCD_set:
case llvm::acc::Directive::ACCD_shutdown:
case llvm::acc::Directive::ACCD_update:
- PushContext(standaloneDir.source, standaloneDir.v);
+ PushAccContext(standaloneDir.source, standaloneDir.v);
break;
default:
break;
}
- ClearDataSharingAttributeObjects();
return true;
}
@@ -1396,10 +1495,10 @@ void AccAttributeVisitor::AddRoutineInfoToSymbol(
bool AccAttributeVisitor::Pre(const parser::OpenACCRoutineConstruct &x) {
const auto &verbatim{std::get<parser::Verbatim>(x.t)};
if (topScope_) {
- PushContext(
+ PushAccContext(
verbatim.source, llvm::acc::Directive::ACCD_routine, *topScope_);
} else {
- PushContext(verbatim.source, llvm::acc::Directive::ACCD_routine);
+ PushAccContext(verbatim.source, llvm::acc::Directive::ACCD_routine);
}
const auto &names{std::get<std::list<parser::Name>>(x.t)};
if (!names.empty()) {
@@ -1473,7 +1572,7 @@ bool AccAttributeVisitor::Pre(const parser::OpenACCCombinedConstruct &x) {
case llvm::acc::Directive::ACCD_kernels_loop:
case llvm::acc::Directive::ACCD_parallel_loop:
case llvm::acc::Directive::ACCD_serial_loop:
- PushContext(x.source, combinedDir.v);
+ PushAccContext(x.source, combinedDir.v);
break;
default:
break;
@@ -1482,7 +1581,6 @@ bool AccAttributeVisitor::Pre(const parser::OpenACCCombinedConstruct &x) {
SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
CheckAssociatedLoop(*outer, HasForceCollapseModifier(clauseList));
- ClearDataSharingAttributeObjects();
return true;
}
@@ -1578,8 +1676,7 @@ void AccAttributeVisitor::AllowOnlyVariable(const parser::AccObject &object) {
bool AccAttributeVisitor::Pre(const parser::OpenACCWaitConstruct &x) {
const auto &verbatim{std::get<parser::Verbatim>(x.t)};
- PushContext(verbatim.source, llvm::acc::Directive::ACCD_wait);
- ClearDataSharingAttributeObjects();
+ PushAccContext(verbatim.source, llvm::acc::Directive::ACCD_wait);
return true;
}
@@ -1596,16 +1693,13 @@ bool AccAttributeVisitor::Pre(const parser::OpenACCAtomicConstruct &x) {
},
},
x.u);
- PushContext(verbatimSource, llvm::acc::Directive::ACCD_atomic);
- ClearDataSharingAttributeObjects();
+ PushAccContext(verbatimSource, llvm::acc::Directive::ACCD_atomic);
return true;
}
bool AccAttributeVisitor::Pre(const parser::OpenACCCacheConstruct &x) {
const auto &verbatim{std::get<parser::Verbatim>(x.t)};
- PushContext(verbatim.source, llvm::acc::Directive::ACCD_cache);
- ClearDataSharingAttributeObjects();
-
+ PushAccContext(verbatim.source, llvm::acc::Directive::ACCD_cache);
const auto &objectListWithModifier =
std::get<parser::AccObjectListWithModifier>(x.t);
const auto &objectList =
@@ -1737,7 +1831,7 @@ void AccAttributeVisitor::CheckAssociatedLoop(
if (level <= 0)
return;
if (ivName && lower && upper) {
- if (auto *symbol{ResolveAcc(*ivName, flag, currScope())}) {
+ if (auto *symbol{DeclareOrMarkOtherAccessEntity(*ivName, flag)}) {
if (auto lowerExpr{semantics::AnalyzeExpr(context_, *lower)}) {
semantics::UnorderedSymbolSet lowerSyms =
evaluate::CollectSymbols(*lowerExpr);
@@ -1825,6 +1919,43 @@ void AccAttributeVisitor::Post(const parser::AccDefaultClause &x) {
}
}
+void AccAttributeVisitor::PushAccContext(
+ const parser::CharBlock &source, llvm::acc::Directive dir, Scope &scope) {
+ dirContext_.emplace_back(source, dir, scope);
+ if (dirContext_.size() > 1) {
+ GetContext().defaultDSA = dirContext_[dirContext_.size() - 2].defaultDSA;
+ }
+}
+
+void AccAttributeVisitor::PushAccContext(
+ const parser::CharBlock &source, llvm::acc::Directive dir) {
+ PushAccContext(source, dir, context_.FindScope(source));
+}
+
+void AccAttributeVisitor::PopAccContext() {
+ CHECK(!dirContext_.empty());
+ dirContext_.pop_back();
+}
+
+DesignatorPath AccAttributeVisitor::MakeBaseDesignatorPath(
+ const Symbol &symbol) {
+ DesignatorPath path;
+ path.SetBase(NamedEntity{symbol.GetUltimate()});
+ return path;
+}
+
+bool AccAttributeVisitor::IsObjectWithVisibleDSA(
+ const DesignatorPath &reference) const {
+ for (std::size_t i{dirContext_.size()}; i != 0; --i) {
+ for (const auto &entry : dirContext_[i - 1].objectsWithDSA) {
+ if (entry.path.MayContain(reference)) {
+ return true;
+ }
+ }
+ }
+ return false;
+}
+
// Returns true iff symbol qualifies for the pre-OpenACC-3.2 DEFAULT(NONE)
// scalar extension: an intrinsic numeric or logical non-array, non-pointer,
// non-allocatable variable. Characters, derived types, allocatables, and
@@ -1844,11 +1975,34 @@ static bool IsAccScalar(const Symbol &symbol) {
return det && !det->IsArray();
}
-void AccAttributeVisitor::Post(const parser::Name &name) {
+void AccAttributeVisitor::AdjustAccSymbolReference(const parser::Name &name) {
+ if (!name.symbol || !WithinConstruct()) {
+ return;
+ }
+ const Symbol &symbol{name.symbol->GetUltimate()};
+ if (symbol.owner().IsDerivedType() || symbol.has<ProcEntityDetails>() ||
+ symbol.has<SubprogramDetails>() || symbol.has<AssocEntityDetails>() ||
+ symbol.has<MiscDetails>()) {
+ return;
+ }
+ if (Symbol *found{currScope().FindSymbol(name.source)};
+ found && &symbol != found) {
+ if (DoesScopeContain(&currScope(), symbol)) {
+ return;
+ }
+ // Adjust the symbol within the region.
+ // TODO: why didn't name resolution set the right name originally?
+ name.symbol = found;
+ }
+}
+
+void AccAttributeVisitor::CheckAccDefaultNoneReference(
+ const parser::Name &name, DesignatorPath designator) {
if (name.symbol && WithinConstruct()) {
const Symbol &symbol{name.symbol->GetUltimate()};
if (!symbol.owner().IsDerivedType() && !symbol.has<ProcEntityDetails>() &&
- !symbol.has<SubprogramDetails>() && !IsObjectWithVisibleDSA(symbol) &&
+ !symbol.has<SubprogramDetails>() &&
+ !IsObjectWithVisibleDSA(designator) &&
!symbol.has<AssocEntityDetails>() && !symbol.has<MiscDetails>()) {
if (Symbol * found{currScope().FindSymbol(name.source)}) {
if (&symbol != found) {
@@ -1892,6 +2046,77 @@ void AccAttributeVisitor::Post(const parser::Name &name) {
}
}
+bool AccAttributeVisitor::Pre(const parser::Expr &) {
+ enterExpressionLikeContext();
+ return true;
+}
+
+template <typename A>
+void AccAttributeVisitor::CheckAccDefaultNoneReferenceIn(const A &x) {
+ if (const auto *designator{
+ std::get_if<common::Indirection<parser::Designator>>(&x.u)}) {
+ std::optional<DesignatorPath> designatorPath{
+ GetDesignatorPath(context_, designator->value())};
+ if (designatorPath) {
+ CheckAccDefaultNoneReference(parser::GetFirstName(designator->value()),
+ std::move(*designatorPath));
+ }
+ } else if (const auto *functionReference{
+ std::get_if<common::Indirection<parser::FunctionReference>>(
+ &x.u)}) {
+ const parser::Name &name{parser::GetFirstName(functionReference->value())};
+ if (WithinConstruct() && GetContext().defaultDSA == Symbol::Flag::AccNone &&
+ name.symbol && name.symbol->has<ObjectEntityDetails>()) {
+ if (std::optional<DesignatorPath> designatorPath{
+ GetDesignatorPath(context_, functionReference->value())}) {
+ CheckAccDefaultNoneReference(name, std::move(*designatorPath));
+ }
+ }
+ }
+}
+
+void AccAttributeVisitor::Post(const parser::Expr &expr) {
+ exitExpressionLikeContext();
+ CheckAccDefaultNoneReferenceIn(expr);
+}
+
+bool AccAttributeVisitor::Pre(const parser::Variable &) {
+ enterExpressionLikeContext();
+ return true;
+}
+
+void AccAttributeVisitor::Post(const parser::Variable &variable) {
+ exitExpressionLikeContext();
+ CheckAccDefaultNoneReferenceIn(variable);
+}
+
+bool AccAttributeVisitor::Pre(const parser::ArrayElement &) {
+ enterExpressionLikeContext();
+ return true;
+}
+
+void AccAttributeVisitor::Post(const parser::ArrayElement &arrayElement) {
+ exitExpressionLikeContext();
+ if (std::optional<DesignatorPath> path{
+ GetDesignatorPath(context_, arrayElement)}) {
+ CheckAccDefaultNoneReference(
+ parser::GetFirstName(arrayElement.Base()), std::move(*path));
+ }
+}
+
+void AccAttributeVisitor::Post(const parser::Name &name) {
+ AdjustAccSymbolReference(name);
+ // A Name reached outside any Expr, Variable, or ArrayElement is a
+ // whole-object reference that no path-aware handler covers -- for instance
+ // the object of an ALLOCATE, DEALLOCATE, or NULLIFY, or the pointer of a
+ // pointer assignment. Its resolved name is an exact base-only path.
+ if (!inExpressionLikeContext()) {
+ if (name.symbol) {
+ CheckAccDefaultNoneReference(name, MakeBaseDesignatorPath(*name.symbol));
+ }
+ }
+}
+
Symbol *AccAttributeVisitor::ResolveAccCommonBlockName(
const parser::Name *name) {
if (name) {
@@ -1970,28 +2195,63 @@ static bool IsOpenACCDeviceMappingFlag(Symbol::Flag flag) {
}
}
+bool AccAttributeVisitor::DiagnoseUnsupportedAccClauseDesignator(
+ const parser::Designator &designator) {
+ // Do not diagnose a syntactically unsupported object until it has been
+ // semantically resolved; otherwise an unresolved name or component should
+ // receive its ordinary Fortran diagnostic instead.
+ if (!AnalyzeExpr(context_, designator)) {
+ return false;
+ }
+ if (std::holds_alternative<parser::Substring>(designator.u)) {
+ context_.Say(designator.source,
+ "Substrings are not allowed on OpenACC directives or clauses"_err_en_US);
+ return true;
+ }
+ if (const auto *dataRef{std::get_if<parser::DataRef>(&designator.u)};
+ dataRef &&
+ std::holds_alternative<common::Indirection<parser::CoindexedNamedObject>>(
+ dataRef->u)) {
+ context_.Say(designator.source,
+ "Coindexed objects are not allowed on OpenACC directives or clauses"_err_en_US);
+ return true;
+ }
+ return false;
+}
+
void AccAttributeVisitor::ResolveAccObject(
const parser::AccObject &accObject, Symbol::Flag accFlag) {
common::visit(
common::visitors{
[&](const parser::Designator &designator) {
- const bool preciseDesignator{
+ // First form an exact structural path. If it cannot be represented,
+ // the check below diagnoses resolved unsupported designators;
+ // unresolved or otherwise invalid designators are not registered.
+ const bool isBareName{
parser::GetDesignatorNameIfDataRef(designator) != nullptr};
- if (!preciseDesignator) {
- // Subscripted designator: evaluate subscripts and detect
- // the substring case that is disallowed in OpenACC clauses.
- if (AnalyzeExpr(context_, designator)) {
- if (std::holds_alternative<parser::Substring>(designator.u)) {
- context_.Say(designator.source,
- "Substrings are not allowed on OpenACC "
- "directives or clauses"_err_en_US);
- return;
- }
+ DesignatorPath designatorPath;
+ bool canCheckMultipleAppearances{isBareName};
+ if (!isBareName) {
+ if (std::optional<DesignatorPath> path{
+ GetDesignatorPath(context_, designator)}) {
+ designatorPath = std::move(*path);
+ canCheckMultipleAppearances = true;
+ }
+ if (DiagnoseUnsupportedAccClauseDesignator(designator)) {
+ return;
}
}
+ // Then resolve the base entity so ACC_DECLARE flags are applied.
if (ContainsStructureComponent(designator)) {
- // Do not register the base object for a component reference until
- // OpenACC DSA tracking can distinguish subcomponents.
+ // Finally register or compare only the complete component path;
+ // a component clause does not cover every reference to its base.
+ if (canCheckMultipleAppearances) {
+ const parser::Name &baseName{parser::GetFirstName(designator)};
+ if (baseName.symbol && !designatorPath.empty()) {
+ CheckClauseConsistencyInCurrentConstruct(
+ baseName, accFlag, std::move(designatorPath), &accObject);
+ }
+ }
return;
}
// GetFirstName extracts the base symbol from both bare data
@@ -1999,27 +2259,30 @@ void AccAttributeVisitor::ResolveAccObject(
// that DEFAULT(NONE) checking does not spuriously flag variables
// that are explicitly listed in a data clause as array sections.
// TODO: Multiple array sections of the same array with different
- // data sharing attributes is not currently supported.
- // TODO: Subcomponent designators should also be tracked precisely.
+ // data mapping attributes is not currently supported.
const parser::Name &baseName{parser::GetFirstName(designator)};
- if (auto *symbol{ResolveAcc(baseName, accFlag, currScope())}) {
- AddToContextObjectWithDSA(*symbol, accFlag);
+ if (auto *symbol{
+ DeclareOrMarkOtherAccessEntity(baseName, accFlag)}) {
+ if (isBareName) {
+ designatorPath = MakeBaseDesignatorPath(*symbol);
+ }
if (GetContext().directive == llvm::acc::Directive::ACCD_data &&
IsOpenACCDeviceMappingFlag(accFlag)) {
currScope().AddOpenACCMappedSymbol(*symbol);
context_.NoteOpenACCDataMapping();
}
- if (preciseDesignator &&
- dataSharingAttributeFlags.test(accFlag)) {
- CheckMultipleAppearances(
- baseName, *symbol, accFlag, &accObject, preciseDesignator);
+ if (canCheckMultipleAppearances && !designatorPath.empty()) {
+ CheckClauseConsistencyInCurrentConstruct(
+ baseName, accFlag, std::move(designatorPath), &accObject);
}
}
},
[&](const parser::Name &name) { // common block
if (auto *symbol{ResolveAccCommonBlockName(&name)}) {
- CheckMultipleAppearances(
- name, *symbol, Symbol::Flag::AccCommonBlock);
+ if (!CheckClauseConsistencyInCurrentConstruct(name, accFlag,
+ MakeBaseDesignatorPath(*symbol), &accObject)) {
+ return;
+ }
// Members of a named COMMON listed in a data clause are not
// recorded as device-mapped. Lowering does not create an
// alternate device binding for them, so CUDA generic resolution
@@ -2027,8 +2290,9 @@ void AccAttributeVisitor::ResolveAccObject(
// designator is handled in the branch above.
for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
if (auto *resolvedObject{
- ResolveAcc(*object, accFlag, currScope())}) {
- AddToContextObjectWithDSA(*resolvedObject, accFlag);
+ DeclareOrMarkOtherAccessEntity(*object, accFlag)}) {
+ CheckClauseConsistencyInCurrentConstruct(name, accFlag,
+ MakeBaseDesignatorPath(*resolvedObject), &accObject);
}
}
} else {
@@ -2041,16 +2305,6 @@ void AccAttributeVisitor::ResolveAccObject(
accObject.u);
}
-Symbol *AccAttributeVisitor::ResolveAcc(
- const parser::Name &name, Symbol::Flag accFlag, Scope &scope) {
- return DeclareOrMarkOtherAccessEntity(name, accFlag);
-}
-
-Symbol *AccAttributeVisitor::ResolveAcc(
- Symbol &symbol, Symbol::Flag accFlag, Scope &scope) {
- return DeclareOrMarkOtherAccessEntity(symbol, accFlag);
-}
-
Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
const parser::Name &name, Symbol::Flag accFlag) {
if (name.symbol) {
@@ -2073,37 +2327,73 @@ Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
return &object;
}
-void AccAttributeVisitor::CheckMultipleAppearances(const parser::Name &name,
- const Symbol &symbol, Symbol::Flag accFlag,
+bool AccAttributeVisitor::CheckClauseConsistencyInCurrentConstruct(
+ const parser::Name &name, Symbol::Flag accFlag, DesignatorPath designator,
const parser::AccObject *occurrence, bool warnSameKindDuplicate) {
- const auto *target{&symbol};
- if (HasDataSharingAttributeObject(*target)) {
- // A same-kind duplicate (e.g. private(x, x) or private(x) private(x))
- // is benign: warn and tag this AccObject occurrence so rewrite-parse-tree
- // can drop it from the clause list. Cross-kind duplicates (e.g.
- // private(x) firstprivate(x)) remain hard errors.
- //
- // Reduction is excluded from the benign case: two reduction clauses
- // with the same Symbol::Flag may still differ in operator, which is a
- // real conflict that dedup would silently hide.
- auto firstFlag{GetContext().FindSymbolWithDSA(*target)};
- if (warnSameKindDuplicate && occurrence && firstFlag &&
- *firstFlag == accFlag && accFlag != Symbol::Flag::AccReduction) {
- context_.Warn(common::UsageWarning::OpenAccUsage, name.source,
- "'%s' appears more than once in the same kind of data-sharing clause on an OpenACC directive; duplicate ignored"_warn_en_US,
- name.ToString());
- context_.MarkAccObjectDuplicate(occurrence);
- } else if (firstFlag && *firstFlag == accFlag &&
- accFlag != Symbol::Flag::AccReduction) {
- return;
- } else {
- context_.Say(name.source,
+ if (designator.empty()) {
+ return false;
+ }
+ const parser::CharBlock source{
+ occurrence ? parser::FindSourceLocation(*occurrence) : name.source};
+ const std::string displayName{source.ToString()};
+ auto &objectsWithDSA{GetContext().objectsWithDSA};
+ for (auto iter{objectsWithDSA.begin()}; iter != objectsWithDSA.end();) {
+ AccDataSharingEntry &entry{iter->value};
+ DesignatorRelation relation{iter->path.Compare(designator)};
+ if (relation == DesignatorRelation::Disjoint) {
+ ++iter;
+ continue;
+ }
+
+ if (!(dataSharingAttributeFlags.test(entry.flag) &&
+ dataSharingAttributeFlags.test(accFlag))) {
+ ++iter;
+ continue;
+ }
+
+ // TODO: Record the reduction operator in AccDataSharingEntry so compatible
+ // reductions can use the ordinary same-kind duplicate handling. Also handle
+ // private/reduction interactions on loop constructs.
+ if (entry.flag != accFlag || accFlag == Symbol::Flag::AccReduction) {
+ auto &message{context_.Say(source,
"'%s' appears in more than one data-sharing clause on the same OpenACC directive"_err_en_US,
- name.ToString());
+ displayName)};
+ if (entry.occurrence) {
+ message.Attach(parser::FindSourceLocation(*entry.occurrence),
+ "previous data-sharing object appears here"_en_US);
+ }
+ return false;
+ }
+
+ switch (relation) {
+ case DesignatorRelation::Equal:
+ if (warnSameKindDuplicate && occurrence) {
+ context_.Warn(common::UsageWarning::OpenAccUsage, source,
+ "'%s' appears more than once in the same kind of data-sharing clause on an OpenACC directive; duplicate ignored"_warn_en_US,
+ displayName);
+ context_.MarkAccObjectDuplicate(occurrence);
+ }
+ return false;
+ case DesignatorRelation::Contains:
+ case DesignatorRelation::ContainedBy:
+ case DesignatorRelation::Overlaps: {
+ // TODO: Support non-identical same-kind objects once their containment
+ // and overlap semantics are defined.
+ auto &message{context_.Say(source,
+ "'%s' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive"_err_en_US,
+ displayName)};
+ if (entry.occurrence) {
+ message.Attach(parser::FindSourceLocation(*entry.occurrence),
+ "previous data-sharing object appears here"_en_US);
+ }
+ return false;
+ }
+ case DesignatorRelation::Disjoint:
+ llvm_unreachable("disjoint relation handled above");
}
- } else {
- AddDataSharingAttributeObject(*target);
}
+ objectsWithDSA.push_back(std::move(designator), {accFlag, occurrence});
+ return true;
}
#ifndef NDEBUG
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 48ff27f214649d..ae0eb95ce4e2b7 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -9,6 +9,8 @@
#include "flang/Parser/tools.h"
#include "flang/Common/indirection.h"
#include "flang/Evaluate/characteristics.h"
+#include "flang/Evaluate/fold.h"
+#include "flang/Evaluate/tools.h"
#include "flang/Parser/dump-parse-tree.h"
#include "flang/Parser/message.h"
#include "flang/Parser/parse-tree.h"
@@ -20,11 +22,196 @@
#include "flang/Support/Fortran.h"
#include "llvm/Support/raw_ostream.h"
#include <algorithm>
+#include <list>
+#include <optional>
#include <set>
+#include <utility>
#include <variant>
+#include <vector>
namespace Fortran::semantics {
+// Parse-tree designator to evaluate::DesignatorPath conversion.
+//
+// These helpers build a DesignatorPath from the parse tree (see the note on
+// GetDesignatorPath in the header). They use already-resolved base and
+// component symbols, and analyze only subscript expressions. Anything that
+// cannot be represented is reported as absent so the caller can skip it.
+template <typename A>
+static std::optional<evaluate::Expr<evaluate::SubscriptInteger>>
+AnalyzeSubscriptExpr(SemanticsContext &context, const A &expr) {
+ if (auto maybe{evaluate::Fold(
+ context.foldingContext(), AnalyzeExpr(context, expr))}) {
+ if (auto *intExpr{
+ evaluate::UnwrapExpr<evaluate::Expr<evaluate::SomeInteger>>(
+ maybe)}) {
+ if (auto value{evaluate::ToInt64(*intExpr)}) {
+ return evaluate::Expr<evaluate::SubscriptInteger>{*value};
+ }
+ return evaluate::ConvertToType<evaluate::SubscriptInteger>(
+ std::move(*intExpr));
+ }
+ }
+ return std::nullopt;
+}
+
+static std::optional<evaluate::Subscript> AnalyzeSectionSubscript(
+ SemanticsContext &context, const parser::SectionSubscript &subscript) {
+ return common::visit(
+ common::visitors{
+ [&](const parser::SubscriptTriplet &triplet)
+ -> std::optional<evaluate::Subscript> {
+ const auto &lower{std::get<0>(triplet.t)};
+ const auto &upper{std::get<1>(triplet.t)};
+ const auto &stride{std::get<2>(triplet.t)};
+ auto lowerExpr{
+ lower ? AnalyzeSubscriptExpr(context, *lower) : std::nullopt};
+ auto upperExpr{
+ upper ? AnalyzeSubscriptExpr(context, *upper) : std::nullopt};
+ auto strideExpr{
+ stride ? AnalyzeSubscriptExpr(context, *stride) : std::nullopt};
+ if ((lower && !lowerExpr) || (upper && !upperExpr) ||
+ (stride && !strideExpr)) {
+ return std::nullopt;
+ }
+ auto result{evaluate::Triplet{std::move(lowerExpr),
+ std::move(upperExpr), std::move(strideExpr)}};
+ return evaluate::Subscript{std::move(result)};
+ },
+ [&](const parser::IntExpr &expr)
+ -> std::optional<evaluate::Subscript> {
+ if (auto subscript{AnalyzeSubscriptExpr(context, expr)}) {
+ return evaluate::Subscript{std::move(*subscript)};
+ }
+ return std::nullopt;
+ },
+ },
+ subscript.u);
+}
+
+static std::optional<std::vector<evaluate::Subscript>> AnalyzeSectionSubscripts(
+ SemanticsContext &context,
+ const std::list<parser::SectionSubscript> &list) {
+ std::vector<evaluate::Subscript> subscripts;
+ for (const parser::SectionSubscript &subscript : list) {
+ if (auto analyzed{AnalyzeSectionSubscript(context, subscript)}) {
+ subscripts.push_back(std::move(*analyzed));
+ } else {
+ return std::nullopt;
+ }
+ }
+ return subscripts;
+}
+
+static bool AddDesignatorPath(SemanticsContext &context,
+ const parser::DataRef &dataRef, evaluate::DesignatorPath &path) {
+ return common::visit(
+ common::visitors{
+ [&](const parser::Name &name) {
+ if (!name.symbol) {
+ return false;
+ }
+ path.SetBase(evaluate::NamedEntity{name.symbol->GetUltimate()});
+ return true;
+ },
+ [&](const common::Indirection<parser::StructureComponent>
+ &component) {
+ if (!AddDesignatorPath(context, component.value().Base(), path)) {
+ return false;
+ }
+ if (const parser::Name &name{component.value().Component()};
+ name.symbol) {
+ path.AddComponent(name.symbol->GetUltimate());
+ return true;
+ }
+ return false;
+ },
+ [&](const common::Indirection<parser::ArrayElement> &arrayElement) {
+ if (!AddDesignatorPath(
+ context, arrayElement.value().Base(), path)) {
+ return false;
+ }
+ if (auto subscripts{AnalyzeSectionSubscripts(
+ context, arrayElement.value().Subscripts())}) {
+ path.AddSubscripts(std::move(*subscripts));
+ return true;
+ }
+ return false;
+ },
+ [](const common::Indirection<parser::CoindexedNamedObject> &) {
+ // DesignatorPath does not represent cosubscripts yet. Do not
+ // collapse a coindexed reference to its local base object.
+ return false;
+ },
+ },
+ dataRef.u);
+}
+
+std::optional<evaluate::DesignatorPath> GetDesignatorPath(
+ SemanticsContext &context, const parser::Designator &designator) {
+ evaluate::DesignatorPath path;
+ bool ok{common::visit(common::visitors{
+ [&](const parser::DataRef &dataRef) {
+ return AddDesignatorPath(context, dataRef, path);
+ },
+ [](const parser::Substring &) { return false; },
+ },
+ designator.u)};
+ if (ok && !path.empty()) {
+ return path;
+ }
+ return std::nullopt;
+}
+
+std::optional<evaluate::DesignatorPath> GetDesignatorPath(
+ SemanticsContext &context, const parser::FunctionReference &funcRef) {
+ const auto &call{funcRef.v};
+ const auto &procedureDesignator{
+ std::get<parser::ProcedureDesignator>(call.t)};
+ const auto *name{std::get_if<parser::Name>(&procedureDesignator.u)};
+ if (!name || !name->symbol || !name->symbol->has<ObjectEntityDetails>()) {
+ return std::nullopt;
+ }
+ std::vector<evaluate::Subscript> subscripts;
+ for (const parser::ActualArgSpec &arg :
+ std::get<std::list<parser::ActualArgSpec>>(call.t)) {
+ if (std::get<std::optional<parser::Keyword>>(arg.t)) {
+ return std::nullopt;
+ }
+ const auto *expr{std::get_if<common::Indirection<parser::Expr>>(
+ &std::get<parser::ActualArg>(arg.t).u)};
+ if (!expr) {
+ return std::nullopt;
+ }
+ if (auto subscript{AnalyzeSubscriptExpr(context, expr->value())}) {
+ subscripts.emplace_back(std::move(*subscript));
+ } else {
+ return std::nullopt;
+ }
+ }
+ if (subscripts.empty()) {
+ return std::nullopt;
+ }
+ evaluate::DesignatorPath path;
+ path.SetBase(evaluate::NamedEntity{name->symbol->GetUltimate()});
+ path.AddSubscripts(std::move(subscripts));
+ return path;
+}
+
+std::optional<evaluate::DesignatorPath> GetDesignatorPath(
+ SemanticsContext &context, const parser::ArrayElement &arrayElement) {
+ evaluate::DesignatorPath path;
+ if (!AddDesignatorPath(context, arrayElement.Base(), path)) {
+ return std::nullopt;
+ }
+ if (auto subscripts{
+ AnalyzeSectionSubscripts(context, arrayElement.Subscripts())}) {
+ path.AddSubscripts(std::move(*subscripts));
+ return path;
+ }
+ return std::nullopt;
+}
+
// Find this or containing scope that matches predicate
static const Scope *FindScopeContaining(
const Scope &start, std::function<bool(const Scope &)> predicate) {
diff --git a/flang/test/Lower/OpenACC/acc-copy-reduction.f90 b/flang/test/Lower/OpenACC/acc-copy-reduction.f90
new file mode 100644
index 00000000000000..5266adf8fc1eea
--- /dev/null
+++ b/flang/test/Lower/OpenACC/acc-copy-reduction.f90
@@ -0,0 +1,31 @@
+! RUN: bbc -fopenacc -emit-hlfir %s -o - | FileCheck %s
+
+subroutine copy_then_reduction()
+ integer :: x
+ !$acc parallel copy(x) reduction(+:x)
+ x = x + 1
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPcopy_then_reduction()
+! CHECK: %[[COPY1:.*]] = acc.copyin varPtr({{.*}}) dataClause(acc_copy) name("x") -> !fir.ref<i32>
+! CHECK: %[[REDUCTION1:.*]] = acc.reduction varPtr({{.*}}) recipe({{.*}}) name("x") -> !fir.ref<i32>
+! CHECK: acc.parallel dataOperands(%[[COPY1]] : !fir.ref<i32>) reduction(%[[REDUCTION1]] : !fir.ref<i32>) {
+! TODO: The region body uses the first mapping for x, making lowering depend on
+! clause order. The reduction mapping should take priority in both cases.
+! CHECK: hlfir.declare %[[COPY1]]
+! CHECK: acc.copyout accPtr(%[[COPY1]] : !fir.ref<i32>)
+
+subroutine reduction_then_copy()
+ integer :: x
+ !$acc parallel reduction(+:x) copy(x)
+ x = x + 1
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPreduction_then_copy()
+! CHECK: %[[REDUCTION2:.*]] = acc.reduction varPtr({{.*}}) recipe({{.*}}) name("x") -> !fir.ref<i32>
+! CHECK: %[[COPY2:.*]] = acc.copyin varPtr({{.*}}) dataClause(acc_copy) name("x") -> !fir.ref<i32>
+! CHECK: acc.parallel dataOperands(%[[COPY2]] : !fir.ref<i32>) reduction(%[[REDUCTION2]] : !fir.ref<i32>) {
+! CHECK: hlfir.declare %[[REDUCTION2]]
+! CHECK: acc.copyout accPtr(%[[COPY2]] : !fir.ref<i32>)
diff --git a/flang/test/Semantics/OpenACC/acc-common.f90 b/flang/test/Semantics/OpenACC/acc-common.f90
index 31c4d190d576bd..356eaf3ab03832 100644
--- a/flang/test/Semantics/OpenACC/acc-common.f90
+++ b/flang/test/Semantics/OpenACC/acc-common.f90
@@ -39,3 +39,13 @@ program acc_decl_test
!ERROR: Could not find COMMON block 'a_common_bad' used in OpenACC directive
!$acc update device (/a_common_bad/)
end program
+
+subroutine common_dsa_conflict()
+ integer :: a, b
+ common /dsa_common/ a, b
+
+ !ERROR: 'dsa_common' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel private(/dsa_common/) firstprivate(/dsa_common/)
+ a = b
+ !$acc end parallel
+end subroutine
diff --git a/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90 b/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90
index 03ed2f1163314d..6f5534aca38edc 100644
--- a/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90
+++ b/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90
@@ -1,10 +1,10 @@
! RUN: %python %S/../test_errors.py %s %flang -fopenacc -fno-openacc-default-none-scalars-strict
-! Derived-type component references in OpenACC clauses are accepted for now, but
-! the current DSA handling is deliberately imprecise:
-! - duplicate and conflicting component references are not diagnosed;
-! - component clauses do not satisfy DEFAULT(NONE) for the base object;
-! - whole-object/component conflicts are not diagnosed.
+! Derived-type component references in OpenACC clauses are accepted. Exact
+! duplicate and conflicting component references in data-sharing clauses are
+! diagnosed, but broader containment is deliberately limited for now:
+! - component clauses satisfy DEFAULT(NONE) only for contained references;
+! - bare whole-object/component conflicts are not diagnosed.
module component_ref_types
implicit none
@@ -35,16 +35,41 @@ subroutine test_component_clauses_are_accepted()
!$acc end parallel
end subroutine
-subroutine test_default_none_component_does_not_cover_object()
+subroutine test_default_none_component_covers_same_component()
use component_ref_types, only: point_t
type(point_t) :: p
- ! TODO: should be an error, needs precise tracking of component references.
!$acc parallel default(none) copy(p%x)
- !ERROR: The DEFAULT(NONE) clause requires that 'p' must be listed in a data-mapping clause
p%x = 1.0
!$acc end parallel
end subroutine
+subroutine test_default_none_component_does_not_cover_sibling()
+ use component_ref_types, only: point_t
+ type(point_t) :: p
+ !$acc parallel default(none) copy(p%x)
+ !ERROR: The DEFAULT(NONE) clause requires that 'p' must be listed in a data-mapping clause
+ p%y = 1.0
+ !$acc end parallel
+end subroutine
+
+subroutine test_default_none_component_covers_contained_component()
+ use component_ref_types, only: nested_t
+ type(nested_t) :: n
+ !$acc parallel default(none) copy(n%pt)
+ n%pt%x = 1.0
+ !$acc end parallel
+end subroutine
+
+subroutine test_default_none_component_does_not_cover_parent()
+ use component_ref_types, only: nested_t, point_t
+ type(nested_t) :: n
+ type(point_t) :: p
+ !$acc parallel default(none) copy(n%pt%x, p)
+ !ERROR: The DEFAULT(NONE) clause requires that 'n' must be listed in a data-mapping clause
+ n%pt = p
+ !$acc end parallel
+end subroutine
+
subroutine test_default_none_whole_object_covers_components()
use component_ref_types, only: point_t
type(point_t) :: p, q
@@ -67,6 +92,7 @@ subroutine test_same_object_same_dsa_components()
use component_ref_types, only: point_t
type(point_t) :: p
integer :: i
+ !WARNING: 'p%x' appears more than once in the same kind of data-sharing clause on an OpenACC directive; duplicate ignored [-Wopenacc-usage]
!$acc parallel loop private(p%x, p%y, p%x)
do i = 1, 10
p%x = real(i)
@@ -79,6 +105,7 @@ subroutine test_same_object_incompatible_same_component()
use component_ref_types, only: point_t
type(point_t) :: p
integer :: i
+ !ERROR: 'p%x' appears in more than one data-sharing clause on the same OpenACC directive
!$acc parallel loop private(p%x) firstprivate(p%x)
do i = 1, 10
p%x = real(i)
@@ -98,10 +125,59 @@ subroutine test_same_object_incompatible_different_components()
!$acc end parallel loop
end subroutine
+subroutine test_contained_component_same_dsa()
+ use component_ref_types, only: nested_t
+ type(nested_t) :: n
+ integer :: i
+ !ERROR: 'n%pt%x' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(n%pt, n%pt%x)
+ do i = 1, 10
+ n%pt%x = real(i)
+ end do
+ !$acc end parallel loop
+end subroutine
+
+subroutine test_contained_component_same_dsa_child_first()
+ use component_ref_types, only: nested_t
+ type(nested_t) :: n
+ integer :: i
+ !ERROR: 'n%pt' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(n%pt%x, n%pt)
+ do i = 1, 10
+ n%pt%x = real(i)
+ end do
+ !$acc end parallel loop
+end subroutine
+
+subroutine test_contained_component_incompatible_parent_first()
+ use component_ref_types, only: nested_t
+ type(nested_t) :: n
+ integer :: i
+ !ERROR: 'n%pt%x' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(n%pt) firstprivate(n%pt%x)
+ do i = 1, 10
+ n%pt%x = real(i)
+ end do
+ !$acc end parallel loop
+end subroutine
+
+subroutine test_contained_component_incompatible_child_first()
+ use component_ref_types, only: nested_t
+ type(nested_t) :: n
+ integer :: i
+ !ERROR: 'n%pt' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(n%pt%x) firstprivate(n%pt)
+ do i = 1, 10
+ n%pt%x = real(i)
+ end do
+ !$acc end parallel loop
+end subroutine
+
subroutine test_whole_object_incompatible_with_component()
use component_ref_types, only: point_t
type(point_t) :: p
integer :: i
+ !ERROR: 'p%x' appears in more than one data-sharing clause on the same OpenACC directive
!$acc parallel loop private(p) firstprivate(p%x)
do i = 1, 10
p%x = real(i)
diff --git a/flang/test/Semantics/OpenACC/acc-copy-reduction.f90 b/flang/test/Semantics/OpenACC/acc-copy-reduction.f90
new file mode 100644
index 00000000000000..585e37b7e0ff06
--- /dev/null
+++ b/flang/test/Semantics/OpenACC/acc-copy-reduction.f90
@@ -0,0 +1,77 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenacc
+
+subroutine copy_then_reduction()
+ integer :: x
+ !$acc parallel copy(x) reduction(+:x)
+ x = x + 1
+ !$acc end parallel
+end subroutine
+
+subroutine reduction_then_copy()
+ integer :: x
+ !$acc parallel reduction(+:x) copy(x)
+ x = x + 1
+ !$acc end parallel
+end subroutine
+
+subroutine parallel_data_clauses_with_reduction()
+ integer :: copy_var, copyin_var, copyout_var, create_var, no_create_var
+ integer :: present_var
+ !$acc parallel copy(copy_var) copyin(copyin_var) &
+ !$acc& copyout(copyout_var) create(create_var) &
+ !$acc& no_create(no_create_var) present(present_var) &
+ !$acc& reduction(+:copy_var, copyin_var, copyout_var, create_var, &
+ !$acc& no_create_var, present_var)
+ copy_var = copy_var + 1
+ copyin_var = copyin_var + 1
+ copyout_var = copyout_var + 1
+ create_var = create_var + 1
+ no_create_var = no_create_var + 1
+ present_var = present_var + 1
+ !$acc end parallel
+end subroutine
+
+subroutine serial_reduction_then_data_clauses()
+ integer :: copy_var, present_var
+ !$acc serial reduction(+:copy_var, present_var) &
+ !$acc& copy(copy_var) present(present_var)
+ copy_var = copy_var + 1
+ present_var = present_var + 1
+ !$acc end serial
+end subroutine
+
+subroutine combined_copy_reduction()
+ integer :: i, x
+ !$acc parallel loop copy(x) reduction(+:x)
+ do i = 1, 10
+ x = x + i
+ end do
+
+ !$acc serial loop reduction(+:x) copy(x)
+ do i = 1, 10
+ x = x + i
+ end do
+
+ !$acc kernels loop copy(x) reduction(+:x)
+ do i = 1, 10
+ x = x + i
+ end do
+end subroutine
+
+subroutine combined_present_reduction()
+ integer :: i, x
+ !$acc parallel loop present(x) reduction(+:x)
+ do i = 1, 10
+ x = x + i
+ end do
+
+ !$acc serial loop reduction(+:x) present(x)
+ do i = 1, 10
+ x = x + i
+ end do
+
+ !$acc kernels loop present(x) reduction(+:x)
+ do i = 1, 10
+ x = x + i
+ end do
+end subroutine
diff --git a/flang/test/Semantics/OpenACC/acc-data-action-overlap.f90 b/flang/test/Semantics/OpenACC/acc-data-action-overlap.f90
new file mode 100644
index 00000000000000..7d0833e4014623
--- /dev/null
+++ b/flang/test/Semantics/OpenACC/acc-data-action-overlap.f90
@@ -0,0 +1,94 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenacc
+
+! Data-action clauses may overlap data-sharing clauses. Only two overlapping
+! data-sharing clauses conflict.
+
+subroutine data_actions_then_private(deviceptr_var)
+ integer :: deviceptr_var
+ integer :: copy_var, copyin_var, copyout_var, create_var, no_create_var
+ integer :: present_var
+ integer, pointer :: attach_var
+ !$acc parallel copy(copy_var) copyin(copyin_var) copyout(copyout_var) &
+ !$acc& create(create_var) no_create(no_create_var) present(present_var) &
+ !$acc& deviceptr(deviceptr_var) attach(attach_var) &
+ !$acc& private(copy_var, copyin_var, copyout_var, create_var, &
+ !$acc& no_create_var, present_var, deviceptr_var, attach_var)
+ copy_var = 1
+ !$acc end parallel
+end subroutine
+
+subroutine firstprivate_then_data_actions(deviceptr_var)
+ integer :: deviceptr_var
+ integer :: copy_var, copyin_var, copyout_var, create_var, no_create_var
+ integer :: present_var
+ integer, pointer :: attach_var
+ !$acc serial firstprivate(copy_var, copyin_var, copyout_var, create_var, &
+ !$acc& no_create_var, present_var, deviceptr_var, attach_var) &
+ !$acc& copy(copy_var) copyin(copyin_var) copyout(copyout_var) &
+ !$acc& create(create_var) no_create(no_create_var) present(present_var) &
+ !$acc& deviceptr(deviceptr_var) attach(attach_var)
+ copy_var = 1
+ !$acc end serial
+end subroutine
+
+subroutine reduction_with_data_actions(deviceptr_var)
+ integer :: deviceptr_var
+ integer :: copy_var, copyin_var, copyout_var, create_var, no_create_var
+ integer :: present_var
+ integer, allocatable :: attach_var
+ !$acc parallel reduction(+:copy_var, copyin_var, copyout_var, create_var, &
+ !$acc& no_create_var, present_var, deviceptr_var, attach_var) &
+ !$acc& copy(copy_var) copyin(copyin_var) copyout(copyout_var) &
+ !$acc& create(create_var) no_create(no_create_var) present(present_var) &
+ !$acc& deviceptr(deviceptr_var) attach(attach_var)
+ copy_var = copy_var + 1
+ !$acc end parallel
+end subroutine
+
+subroutine overlapping_data_actions(deviceptr_var)
+ integer :: deviceptr_var
+ integer :: x
+ integer, pointer :: p
+ !$acc kernels copy(x) copyin(x) copyout(x) create(x) no_create(x) present(x)
+ x = 1
+ !$acc end kernels
+
+ !$acc kernels deviceptr(deviceptr_var) copy(deviceptr_var)
+ deviceptr_var = 1
+ !$acc end kernels
+
+ !$acc kernels attach(p) copy(p) present(p)
+ p = 1
+ !$acc end kernels
+end subroutine
+
+subroutine combined_data_action_private()
+ integer :: i, x
+ !$acc parallel loop copy(x) private(x)
+ do i = 1, 10
+ x = i
+ end do
+
+ !$acc serial loop private(x) present(x)
+ do i = 1, 10
+ x = i
+ end do
+
+ !$acc kernels loop create(x) private(x)
+ do i = 1, 10
+ x = i
+ end do
+end subroutine
+
+subroutine common_block_data_action_private()
+ integer :: a, b
+ common /overlap_common/ a, b
+ !$acc declare link(/overlap_common/)
+ !$acc parallel copy(/overlap_common/) private(/overlap_common/)
+ a = 1
+ !$acc end parallel
+
+ !$acc serial firstprivate(/overlap_common/) copyin(/overlap_common/)
+ b = 1
+ !$acc end serial
+end subroutine
diff --git a/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90 b/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90
index e29332578a0bf2..143f99f5d34b46 100644
--- a/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90
+++ b/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90
@@ -64,6 +64,30 @@ program test_dataclause_dedup
do i = 1, 10
end do
+ ! A reduction still conflicts with explicit privatization on the same
+ ! directive.
+ !ERROR: 'x' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel private(x) reduction(+:x)
+ x = x + 1
+ !$acc end parallel
+
+ !ERROR: 'x' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc serial firstprivate(x) reduction(+:x)
+ x = x + 1
+ !$acc end serial
+
+ !ERROR: 'x' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(x) reduction(+:x)
+ do i = 1, 10
+ x = x + i
+ end do
+
+ !ERROR: 'x' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc serial loop firstprivate(x) reduction(+:x)
+ do i = 1, 10
+ x = x + i
+ end do
+
! Reduction is excluded from the benign case: same-flag duplicates may
! differ in operator, which is a real conflict.
!ERROR: 'x' appears in more than one data-sharing clause on the same OpenACC directive
@@ -71,11 +95,13 @@ program test_dataclause_dedup
do i = 1, 10
end do
- ! Regression coverage for non-bare designators: the dedup machinery only
- ! examines simple-Name DataRefs, so distinct array elements and array
- ! sections must pass through untouched, with no warning and no erasure.
+ ! Regression coverage for non-bare designators: distinct array elements and
+ ! sections must pass through untouched, while exact duplicates are diagnosed
+ ! precisely rather than by the base array symbol.
block
integer :: arr(10)
+ integer :: lo, mid, hi, idx
+ integer, parameter :: left = 1, split = 5, right = 10
integer, target :: t1, t2
integer, pointer :: p
type :: pt
@@ -94,26 +120,146 @@ program test_dataclause_dedup
do i = 1, 10
end do
- ! Same array element listed twice -- not deduped, since GetDesignatorName-
- ! IfDataRef returns null for ArrayElement and CheckMultipleAppearances
- ! is never invoked. Compiles without diagnostics.
+ ! Different array elements in different data-sharing clauses -- not
+ ! duplicates.
+ !$acc parallel loop private(arr(1)) firstprivate(arr(2))
+ do i = 1, 10
+ end do
+
+ ! Different array sections in different data-sharing clauses -- not
+ ! duplicates.
+ !$acc parallel loop private(arr(1:5)) firstprivate(arr(6:10))
+ do i = 1, 10
+ end do
+
+ ! A literal element outside a literal section is disjoint across
+ ! data-sharing kinds.
+ !$acc parallel loop private(arr(1:5)) firstprivate(arr(6))
+ do i = 1, 10
+ end do
+
+ ! Named constant sections that fold to disjoint ranges are not conflicts.
+ !$acc parallel loop private(arr(left:split)) firstprivate(arr(split+1:right))
+ do i = 1, 10
+ end do
+
+ ! Same array element listed twice in the same data-sharing clause.
+ !WARNING: 'arr(1)' appears more than once in the same kind of data-sharing clause on an OpenACC directive; duplicate ignored [-Wopenacc-usage]
!$acc parallel loop private(arr(1), arr(1))
do i = 1, 10
end do
- ! Same array section listed twice -- same reasoning, no diagnostic.
+ ! Same array element with different source spelling.
+ !WARNING: 'arr(01)' appears more than once in the same kind of data-sharing clause on an OpenACC directive; duplicate ignored [-Wopenacc-usage]
+ !$acc parallel loop private(arr(1), arr(01))
+ do i = 1, 10
+ end do
+
+ ! Same array element listed in conflicting data-sharing clauses.
+ !ERROR: 'arr(1)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(arr(1)) firstprivate(arr(1))
+ do i = 1, 10
+ end do
+
+ ! Same array section listed twice in the same data-sharing clause.
+ !WARNING: 'arr(1:5)' appears more than once in the same kind of data-sharing clause on an OpenACC directive; duplicate ignored [-Wopenacc-usage]
!$acc parallel loop private(arr(1:5), arr(1:5))
do i = 1, 10
end do
+ ! Same array section listed in conflicting data-sharing clauses.
+ !ERROR: 'arr(1:5)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(arr(1:5)) firstprivate(arr(1:5))
+ do i = 1, 10
+ end do
+
+ ! Same array section with different source spelling.
+ !WARNING: 'arr(01:05)' appears more than once in the same kind of data-sharing clause on an OpenACC directive; duplicate ignored [-Wopenacc-usage]
+ !$acc parallel loop private(arr(1:5), arr(01:05))
+ do i = 1, 10
+ end do
+
+ ! Equivalent array sections with different source spelling in conflicting
+ ! data-sharing clauses.
+ !ERROR: 'arr(01:05)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(arr(1:5)) firstprivate(arr(01:05))
+ do i = 1, 10
+ end do
+
+ ! Non-identical sections that overlap in the same data-sharing kind are
+ ! rejected until precise overlap support is implemented.
+ !ERROR: 'arr(5:10)' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(arr(1:5), arr(5:10))
+ do i = 1, 10
+ end do
+
+ ! Overlapping literal sections in different data-sharing kinds conflict.
+ !ERROR: 'arr(5:10)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(arr(1:5)) firstprivate(arr(5:10))
+ do i = 1, 10
+ end do
+
+ ! A section and its contained element are likewise rejected in either
+ ! order until precise containment support is implemented.
+ !ERROR: 'arr(3)' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(arr(1:5), arr(3))
+ do i = 1, 10
+ end do
+
+ !ERROR: 'arr(1:5)' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(arr(3), arr(1:5))
+ do i = 1, 10
+ end do
+
+ ! An element contained in a section conflicts across data-sharing kinds.
+ !ERROR: 'arr(3)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(arr(1:5)) firstprivate(arr(3))
+ do i = 1, 10
+ end do
+
+ ! Variable index/section containment cannot yet be proven, so it is treated
+ ! as disjoint.
+ !$acc parallel loop private(arr(idx), arr(lo:hi))
+ do i = 1, 10
+ end do
+
+ ! Variable index/section overlap is ambiguous, so assume disjoint across
+ ! data-sharing kinds unless overlap can be proven.
+ !$acc parallel loop private(arr(lo:hi)) firstprivate(arr(idx))
+ do i = 1, 10
+ end do
+
+ ! Identical variable indices conflict across data-sharing kinds.
+ !ERROR: 'arr(idx)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(arr(idx)) firstprivate(arr(idx))
+ do i = 1, 10
+ end do
+
+ ! Variable section overlap cannot yet be proven, so it is treated as
+ ! disjoint.
+ !$acc parallel loop private(arr(lo:hi), arr(mid:hi))
+ do i = 1, 10
+ end do
+
+ ! Variable section overlap is ambiguous, so assume disjoint across
+ ! data-sharing kinds unless overlap can be proven.
+ !$acc parallel loop private(arr(lo:hi)) firstprivate(arr(mid:hi))
+ do i = 1, 10
+ end do
+
+ ! Identical variable sections conflict across data-sharing kinds.
+ !ERROR: 'arr(lo:hi)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(arr(lo:hi)) firstprivate(arr(lo:hi))
+ do i = 1, 10
+ end do
+
! Distinct structure components -- not duplicates.
!$acc parallel loop private(s%a, s%b)
do i = 1, 10
end do
- ! Mixing a bare-name designator and an array-element designator on the
- ! same symbol must not trigger dedup -- the array element doesn't go
- ! through the duplicate check at all.
+ ! A whole array and an element are not distinct data-sharing objects.
+ !ERROR: 'arr(1)' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive
!$acc parallel loop private(arr, arr(1))
do i = 1, 10
end do
diff --git a/flang/test/Semantics/OpenACC/acc-default-none-arrays.f90 b/flang/test/Semantics/OpenACC/acc-default-none-arrays.f90
index ee1587f66034f9..df990f4f58f57a 100644
--- a/flang/test/Semantics/OpenACC/acc-default-none-arrays.f90
+++ b/flang/test/Semantics/OpenACC/acc-default-none-arrays.f90
@@ -1,10 +1,9 @@
! RUN: %python %S/../test_errors.py %s %flang -fopenacc -fno-openacc-default-none-scalars-strict -Wno-openacc-default-none-scalars-strict
! Verify that array sections explicitly listed in OpenACC data clauses are
-! correctly registered as having a DSA, so DEFAULT(NONE) does not produce
-! spurious errors. This does not implement section-level overlap
-! detection or deduplication; duplicate/conflict diagnostics only apply to bare
-! names. This also covers the substring-in-clause error.
+! correctly registered as having a DSA, so DEFAULT(NONE) uses path containment
+! rather than treating a listed array section as covering every reference to the
+! base array. This also covers the substring-in-clause error.
! 1. Data-mapping clauses with array sections: no DEFAULT(NONE) errors.
subroutine test_data_mapping_sections(n)
@@ -26,6 +25,62 @@ subroutine test_data_mapping_sections(n)
!$acc end kernels
end subroutine
+subroutine test_default_none_literal_section_contains_element()
+ implicit none
+ real :: a(10)
+ !$acc parallel default(none) copy(a(1:5))
+ a(3) = 1.0
+ !$acc end parallel
+end subroutine
+
+subroutine test_default_none_literal_section_rejects_disjoint_element()
+ implicit none
+ real :: a(10)
+ !$acc parallel default(none) copy(a(1:5))
+ !ERROR: The DEFAULT(NONE) clause requires that 'a' must be listed in a data-mapping clause
+ a(6) = 1.0
+ !$acc end parallel
+end subroutine
+
+subroutine test_default_none_literal_section_rejects_partially_overlapping_section()
+ implicit none
+ real :: a(10)
+ !$acc parallel default(none) copy(a(1:5))
+ !ERROR: The DEFAULT(NONE) clause requires that 'a' must be listed in a data-mapping clause
+ a(5:10) = 1.0
+ !$acc end parallel
+end subroutine
+
+subroutine test_default_none_literal_section_rejects_full_section()
+ implicit none
+ real :: a(10)
+ !$acc parallel default(none) copy(a(1:5))
+ !ERROR: The DEFAULT(NONE) clause requires that 'a' must be listed in a data-mapping clause
+ a(:) = 1.0
+ !$acc end parallel
+end subroutine
+
+subroutine test_default_none_full_section_contains_element()
+ implicit none
+ real :: a(10)
+ !$acc parallel default(none) copy(a(:))
+ a = 0.0
+ a(10) = 1.0
+ !$acc end parallel
+end subroutine
+
+subroutine test_default_none_variable_section_lenient(n, lo, hi, i, j, mid)
+ implicit none
+ integer, intent(in) :: n, lo, hi, i, j, mid
+ real :: a(n), b(n), c(n)
+ !$acc parallel default(none) copy(a(lo:hi), b(i), c(1:5))
+ a(i) = 1.0
+ a(mid:hi) = 2.0
+ b(j) = 3.0
+ c(j) = 4.0
+ !$acc end parallel
+end subroutine
+
! 2. Private clause with array section: no DEFAULT(NONE) error.
subroutine test_private_section(n)
implicit none
@@ -65,9 +120,8 @@ subroutine test_unlisted_array(n)
end subroutine
! 5. Duplicate bare-name under the same data-sharing clause: warn and dedup.
-! (Array sections like private(a(1:5), a(6:10)) are not deduplicated or
-! checked for overlap because base-name comparison cannot distinguish
-! different sections of the same array.)
+! Exact section duplicates are also diagnosed, but overlapping or distinct
+! sections like private(a(1:5), a(6:10)) are not treated as duplicates.
subroutine test_duplicate_private_bare(n)
implicit none
integer, intent(in) :: n
@@ -95,7 +149,20 @@ subroutine test_cross_kind_bare(n)
!$acc end parallel loop
end subroutine
-! 7. Substring in an OpenACC clause is disallowed.
+! 7. Data-sharing entries are scoped to one directive. Reusing an object in a
+! later, sequential region must not be diagnosed as a duplicate.
+subroutine test_sequential_regions_have_independent_data_sharing_entries()
+ implicit none
+ real :: a(10)
+ !$acc parallel copy(a)
+ a = 1.0
+ !$acc end parallel
+ !$acc parallel copy(a)
+ a = 2.0
+ !$acc end parallel
+end subroutine
+
+! 8. Substring in an OpenACC clause is disallowed.
subroutine test_substring()
implicit none
character(len=10) :: str
@@ -104,9 +171,37 @@ subroutine test_substring()
!$acc end parallel
end subroutine
-! 8. Same array section in conflicting private and copy clauses.
-! TODO: cross-kind detection for array sections is not implemented; no error
-! produced for 'a(1:n)' appearing in both copy and private.
+! 8a. A coindexed object is not an OpenACC data-clause var.
+subroutine test_coindexed_object()
+ implicit none
+ integer, save :: coarray[*]
+ !ERROR: Coindexed objects are not allowed on OpenACC directives or clauses
+ !$acc parallel default(none) copyin(coarray[1])
+ !$acc end parallel
+end subroutine
+
+! 8b. Invalid objects must retain their ordinary Fortran semantic errors;
+! they must not be mistaken for a resolved OpenACC object that happens
+! not to have a DesignatorPath.
+subroutine test_unresolved_clause_objects()
+ implicit none
+ type :: t
+ integer :: present
+ end type
+ type(t) :: x
+ !ERROR: Component 'missing' not found in derived type 't'
+ !$acc parallel copyin(x%missing)
+ !$acc end parallel
+ !ERROR: No explicit type declared for 'missing_substring'
+ !$acc parallel copyin(missing_substring(1:5))
+ !$acc end parallel
+ !ERROR: No explicit type declared for 'missing_coarray'
+ !$acc parallel copyin(missing_coarray[1])
+ !$acc end parallel
+end subroutine
+
+! 9. The same array section may appear in a data-action clause and a
+! data-sharing clause.
subroutine test_cross_kind_sections(n)
implicit none
integer, intent(in) :: n
@@ -119,9 +214,8 @@ subroutine test_cross_kind_sections(n)
!$acc end parallel loop
end subroutine
-! 9. Different sections of the same array in conflicting copy and private clauses.
-! TODO: cross-kind detection for array sections is not implemented; no error
-! produced for 'a' appearing in both copy and private.
+! 10. Different sections may likewise appear in data-action and data-sharing
+! clauses.
subroutine test_cross_kind_sections2(n)
implicit none
integer, intent(in) :: n
diff --git a/flang/test/Semantics/OpenACC/acc-default-none-object-refs.f90 b/flang/test/Semantics/OpenACC/acc-default-none-object-refs.f90
new file mode 100644
index 00000000000000..5347401dbf5f3e
--- /dev/null
+++ b/flang/test/Semantics/OpenACC/acc-default-none-object-refs.f90
@@ -0,0 +1,73 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenacc
+
+! DEFAULT(NONE) must also diagnose references to variables that appear in the
+! parse tree as a bare object rather than as an Expr, Variable, or ArrayElement:
+! the objects of ALLOCATE/DEALLOCATE/NULLIFY and the pointer target of a pointer
+! assignment. These reach the parse-tree walk as a Name or StructureComponent,
+! not wrapped in an Expr/Variable/ArrayElement, so they need dedicated handling.
+
+! 1. Unlisted objects of allocate/deallocate/nullify are diagnosed.
+subroutine test_object_refs_unlisted()
+ implicit none
+ real, allocatable :: q(:)
+ real, pointer :: p(:)
+ !$acc parallel default(none)
+ !ERROR: The DEFAULT(NONE) clause requires that 'q' must be listed in a data-mapping clause
+ allocate(q(10))
+ !ERROR: The DEFAULT(NONE) clause requires that 'q' must be listed in a data-mapping clause
+ deallocate(q)
+ !ERROR: The DEFAULT(NONE) clause requires that 'p' must be listed in a data-mapping clause
+ nullify(p)
+ !$acc end parallel
+end subroutine
+
+! 2. Unlisted pointer target and pointee of a pointer assignment are diagnosed.
+! The left-hand side (the pointer) is the reference the parse tree exposes as
+! a bare DataRef; the right-hand side is an Expr and was already checked.
+subroutine test_pointer_assign_unlisted()
+ implicit none
+ real, pointer :: p(:), tg(:)
+ !$acc parallel default(none)
+ !ERROR: The DEFAULT(NONE) clause requires that 'p' must be listed in a data-mapping clause
+ !ERROR: The DEFAULT(NONE) clause requires that 'tg' must be listed in a data-mapping clause
+ p => tg
+ !$acc end parallel
+end subroutine
+
+! 3. A structure-component object still reports its base variable.
+subroutine test_object_ref_component()
+ implicit none
+ type t
+ real, pointer :: p(:)
+ end type
+ type(t) :: a
+ !$acc parallel default(none)
+ !ERROR: The DEFAULT(NONE) clause requires that 'a' must be listed in a data-mapping clause
+ nullify(a%p)
+ !$acc end parallel
+end subroutine
+
+! 4. Listed objects do not error.
+subroutine test_object_refs_listed()
+ implicit none
+ real, allocatable :: q(:)
+ real, pointer :: p(:)
+ !$acc parallel default(none) create(q) copyin(p)
+ allocate(q(10))
+ deallocate(q)
+ nullify(p)
+ !$acc end parallel
+end subroutine
+
+! 5. Without DEFAULT(NONE) the object references are not flagged.
+subroutine test_object_refs_no_default_none()
+ implicit none
+ real, allocatable :: q(:)
+ real, pointer :: p(:), tg(:)
+ !$acc parallel
+ allocate(q(10))
+ deallocate(q)
+ nullify(p)
+ p => tg
+ !$acc end parallel
+end subroutine
diff --git a/flang/unittests/Evaluate/CMakeLists.txt b/flang/unittests/Evaluate/CMakeLists.txt
index ed012828a7258e..275725ed8e9174 100644
--- a/flang/unittests/Evaluate/CMakeLists.txt
+++ b/flang/unittests/Evaluate/CMakeLists.txt
@@ -20,6 +20,14 @@ add_flang_nongtest_unittest(expression
FortranParser
)
+add_flang_nongtest_unittest(designator-path
+ FortranSupport
+ NonGTestTesting
+ FortranEvaluate
+ FortranSemantics
+ FortranParser
+)
+
add_flang_nongtest_unittest(integer
NonGTestTesting
FortranEvaluate
diff --git a/flang/unittests/Evaluate/designator-path.cpp b/flang/unittests/Evaluate/designator-path.cpp
new file mode 100644
index 00000000000000..60ab4fbe0a0477
--- /dev/null
+++ b/flang/unittests/Evaluate/designator-path.cpp
@@ -0,0 +1,392 @@
+//===-- flang/unittests/Evaluate/designator-path.cpp ---------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Evaluate/designator-path.h"
+#include "flang/Evaluate/expression.h"
+#include "flang/Parser/provenance.h"
+#include "flang/Semantics/scope.h"
+#include "flang/Semantics/semantics.h"
+#include "flang/Semantics/symbol.h"
+#include "flang/Support/Fortran-features.h"
+#include "flang/Support/LangOptions.h"
+#include "flang/Support/default-kinds.h"
+#include "flang/Testing/testing.h"
+
+using namespace Fortran::evaluate;
+
+namespace {
+namespace common = Fortran::common;
+namespace parser = Fortran::parser;
+namespace semantics = Fortran::semantics;
+using IntExpr = Expr<SubscriptInteger>;
+
+IntExpr Int(int n) { return IntExpr{n}; }
+
+Subscript Scalar(int n) { return Subscript{Int(n)}; }
+
+Triplet TripletSubscript(
+ std::optional<int> lower, std::optional<int> upper, int stride = 1) {
+ return Triplet{lower ? std::optional<IntExpr>{Int(*lower)} : std::nullopt,
+ upper ? std::optional<IntExpr>{Int(*upper)} : std::nullopt, Int(stride)};
+}
+
+Subscript Section(
+ std::optional<int> lower, std::optional<int> upper, int stride = 1) {
+ return Subscript{TripletSubscript(lower, upper, stride)};
+}
+
+Subscript FullSection() {
+ return Subscript{Triplet{std::nullopt, std::nullopt, Int(1)}};
+}
+
+DesignatorPath PathWithSubscripts(std::vector<Subscript> subscripts) {
+ DesignatorPath path;
+ path.AddSubscripts(std::move(subscripts));
+ return path;
+}
+
+DesignatorPath PathWithComponent(const semantics::Symbol *symbol) {
+ DesignatorPath path;
+ path.AddComponent(*symbol);
+ return path;
+}
+
+void CheckRelation(const DesignatorPath &x, const DesignatorPath &y,
+ DesignatorRelation relation) {
+ TEST(x.Compare(y) == relation);
+}
+
+class SymbolFixture {
+public:
+ const semantics::Symbol &MakeSymbol(const char *name) {
+ return scope_.MakeSymbol(parser::CharBlock{name}, semantics::Attrs{},
+ semantics::UnknownDetails{});
+ }
+
+private:
+ parser::AllSources allSources_;
+ parser::AllCookedSources allCookedSources_{allSources_};
+ common::IntrinsicTypeDefaultKinds defaultKinds_;
+ common::LanguageFeatureControl languageFeatures_;
+ common::LangOptions langOptions_;
+ semantics::SemanticsContext context_{
+ defaultKinds_, languageFeatures_, langOptions_, allCookedSources_};
+ semantics::Scope &scope_{
+ context_.globalScope().MakeScope(semantics::Scope::Kind::MainProgram)};
+};
+
+void TestGetConstantSubscriptRange() {
+ auto scalarRange{DesignatorPath::GetConstantSubscriptRange(Scalar(4))};
+ TEST(scalarRange.has_value());
+ TEST(scalarRange->lower == 4);
+ TEST(scalarRange->upper == 4);
+
+ auto sectionRange{DesignatorPath::GetConstantSubscriptRange(Section(2, 7))};
+ TEST(sectionRange.has_value());
+ TEST(sectionRange->lower == 2);
+ TEST(sectionRange->upper == 7);
+
+ TEST(!DesignatorPath::GetConstantSubscriptRange(Section(2, 7, 2)));
+ TEST(!DesignatorPath::GetConstantSubscriptRange(FullSection()));
+}
+
+void TestFullTripletDetection() {
+ TEST(DesignatorPath::IsFullTriplet(TripletSubscript({}, {})));
+ TEST(!DesignatorPath::IsFullTriplet(TripletSubscript(1, {})));
+ TEST(!DesignatorPath::IsFullTriplet(TripletSubscript({}, 10)));
+ TEST(!DesignatorPath::IsFullTriplet(TripletSubscript({}, {}, 2)));
+}
+
+void TestCompareSubscripts() {
+ TEST(DesignatorPath::CompareSubscripts(Scalar(3), Scalar(3)) ==
+ DesignatorRelation::Equal);
+ TEST(DesignatorPath::CompareSubscripts(FullSection(), Scalar(3)) ==
+ DesignatorRelation::Contains);
+ TEST(DesignatorPath::CompareSubscripts(FullSection(), FullSection()) ==
+ DesignatorRelation::Equal);
+ TEST(DesignatorPath::CompareSubscripts(Scalar(3), FullSection()) ==
+ DesignatorRelation::ContainedBy);
+ TEST(DesignatorPath::CompareSubscripts(Section(1, 5), Section(6, 10)) ==
+ DesignatorRelation::Disjoint);
+ TEST(DesignatorPath::CompareSubscripts(Section(1, 5), Section(1, 5)) ==
+ DesignatorRelation::Equal);
+ TEST(DesignatorPath::CompareSubscripts(Section(1, 10), Section(3, 5)) ==
+ DesignatorRelation::Contains);
+ TEST(DesignatorPath::CompareSubscripts(Section(3, 5), Section(1, 10)) ==
+ DesignatorRelation::ContainedBy);
+ TEST(DesignatorPath::CompareSubscripts(Section(1, 5), Section(5, 10)) ==
+ DesignatorRelation::Overlaps);
+ TEST(DesignatorPath::CompareSubscripts(Section(1, 5, 2), Section(1, 5)) ==
+ DesignatorRelation::Disjoint);
+}
+
+void TestCompareSubscriptLists() {
+ TEST(DesignatorPath::CompareSubscriptLists({}, {FullSection()}) ==
+ DesignatorRelation::Equal);
+ TEST(DesignatorPath::CompareSubscriptLists({FullSection()}, {}) ==
+ DesignatorRelation::Equal);
+ TEST(DesignatorPath::CompareSubscriptLists({FullSection()},
+ {FullSection(), FullSection()}) == DesignatorRelation::Disjoint);
+ TEST(DesignatorPath::CompareSubscriptLists({Scalar(1)},
+ {Scalar(1), Scalar(2)}) == DesignatorRelation::Disjoint);
+ TEST(DesignatorPath::CompareSubscriptLists({Scalar(1), Scalar(2)},
+ {Scalar(1), Scalar(2)}) == DesignatorRelation::Equal);
+ TEST(DesignatorPath::CompareSubscriptLists({Section(1, 10), Scalar(2)},
+ {Section(3, 5), Scalar(2)}) == DesignatorRelation::Contains);
+ TEST(DesignatorPath::CompareSubscriptLists({Section(3, 5), Scalar(2)},
+ {Section(1, 10), Scalar(2)}) == DesignatorRelation::ContainedBy);
+ TEST(DesignatorPath::CompareSubscriptLists({Section(1, 10), Scalar(2)},
+ {Section(3, 5), FullSection()}) == DesignatorRelation::Overlaps);
+ TEST(DesignatorPath::CompareSubscriptLists({Section(1, 5), Scalar(2)},
+ {Section(6, 10), Scalar(2)}) == DesignatorRelation::Disjoint);
+}
+
+void TestCompareParts() {
+ SymbolFixture symbols;
+ const semantics::Symbol &symbol1{symbols.MakeSymbol("a")};
+ const semantics::Symbol &symbol2{symbols.MakeSymbol("b")};
+ DesignatorPath::Part component1{{}, &symbol1};
+ DesignatorPath::Part component1Again{{}, &symbol1};
+ DesignatorPath::Part component2{{}, &symbol2};
+ DesignatorPath::Part subscripts{{Section(1, 5)}, nullptr};
+ DesignatorPath::Part subscriptedComponent{{Scalar(3)}, &symbol1};
+
+ TEST(DesignatorPath::CompareParts(component1, component1Again) ==
+ DesignatorRelation::Equal);
+ TEST(DesignatorPath::CompareParts(component1, component2) ==
+ DesignatorRelation::Disjoint);
+ TEST(DesignatorPath::CompareParts(component1, subscripts) ==
+ DesignatorRelation::Overlaps);
+ TEST(DesignatorPath::CompareParts(subscripts, subscriptedComponent) ==
+ DesignatorRelation::Contains);
+}
+
+void TestCombineRelations() {
+ TEST(DesignatorPath::CombineRelations(false, false, false) ==
+ DesignatorRelation::Equal);
+ TEST(DesignatorPath::CombineRelations(true, false, false) ==
+ DesignatorRelation::Contains);
+ TEST(DesignatorPath::CombineRelations(false, true, false) ==
+ DesignatorRelation::ContainedBy);
+ TEST(DesignatorPath::CombineRelations(false, false, true) ==
+ DesignatorRelation::Overlaps);
+ TEST(DesignatorPath::CombineRelations(true, true, false) ==
+ DesignatorRelation::Overlaps);
+}
+
+void TestComparePaths() {
+ DesignatorPath empty;
+ CheckRelation(empty, empty, DesignatorRelation::Equal);
+ CheckRelation(
+ empty, PathWithSubscripts({Scalar(1)}), DesignatorRelation::Disjoint);
+
+ CheckRelation(PathWithSubscripts({Scalar(1)}),
+ PathWithSubscripts({Scalar(1)}), DesignatorRelation::Equal);
+ CheckRelation(PathWithSubscripts({Section(1, 10)}),
+ PathWithSubscripts({Scalar(5)}), DesignatorRelation::Contains);
+ CheckRelation(PathWithSubscripts({Scalar(5)}),
+ PathWithSubscripts({Section(1, 10)}), DesignatorRelation::ContainedBy);
+ CheckRelation(PathWithSubscripts({Section(1, 5)}),
+ PathWithSubscripts({Section(5, 10)}), DesignatorRelation::Overlaps);
+ CheckRelation(PathWithSubscripts({Section(1, 5)}),
+ PathWithSubscripts({Section(6, 10)}), DesignatorRelation::Disjoint);
+
+ SymbolFixture symbols;
+ const semantics::Symbol &symbol{symbols.MakeSymbol("c")};
+ DesignatorPath parent{PathWithComponent(&symbol)};
+ DesignatorPath child{PathWithComponent(&symbol)};
+ child.AddSubscripts({Scalar(1)});
+ CheckRelation(parent, child, DesignatorRelation::Contains);
+ CheckRelation(child, parent, DesignatorRelation::ContainedBy);
+}
+
+void TestMayContainSubscripts() {
+ TEST(DesignatorPath::SubscriptMayContain(Scalar(1), Scalar(1)));
+ TEST(DesignatorPath::SubscriptMayContain(FullSection(), Scalar(7)));
+ TEST(!DesignatorPath::SubscriptMayContain(Scalar(7), FullSection()));
+ TEST(!DesignatorPath::SubscriptMayContain(Section(1, 5), FullSection()));
+ TEST(DesignatorPath::SubscriptMayContain(Section(1, 10), Scalar(7)));
+ TEST(!DesignatorPath::SubscriptMayContain(Section(1, 5), Scalar(7)));
+ TEST(DesignatorPath::SubscriptMayContain(Section(1, 5, 2), Scalar(7)));
+ TEST(!DesignatorPath::SubscriptListMayContain(
+ {Scalar(1)}, {Scalar(1), Scalar(2)}));
+ TEST(DesignatorPath::SubscriptListMayContain({FullSection()}, {}));
+ TEST(!DesignatorPath::SubscriptListMayContain(
+ {FullSection()}, {Scalar(1), Scalar(2)}));
+ TEST(DesignatorPath::SubscriptListMayContain(
+ {FullSection(), Section(1, 10)}, {Scalar(2), Scalar(5)}));
+}
+
+void TestMayContainPartsAndPaths() {
+ SymbolFixture symbols;
+ const semantics::Symbol &symbol1{symbols.MakeSymbol("d")};
+ const semantics::Symbol &symbol2{symbols.MakeSymbol("e")};
+ DesignatorPath::Part component1{{}, &symbol1};
+ DesignatorPath::Part component2{{}, &symbol2};
+ DesignatorPath::Part subscripts{{Section(1, 10)}, nullptr};
+ DesignatorPath::Part scalarSubscript{{Scalar(5)}, nullptr};
+ DesignatorPath::Part scalarComponent{{Scalar(5)}, &symbol1};
+
+ TEST(DesignatorPath::PartMayContain(component1, component1));
+ TEST(!DesignatorPath::PartMayContain(component1, component2));
+ TEST(DesignatorPath::PartMayContain(subscripts, scalarComponent));
+ TEST(DesignatorPath::PartMayContain(subscripts, scalarSubscript));
+
+ DesignatorPath empty;
+ DesignatorPath parent{PathWithComponent(&symbol1)};
+ DesignatorPath child{PathWithComponent(&symbol1)};
+ child.AddSubscripts({Scalar(1)});
+ DesignatorPath sibling{PathWithComponent(&symbol2)};
+
+ TEST(empty.MayContain(parent));
+ TEST(parent.MayContain(parent));
+ TEST(parent.MayContain(child));
+ TEST(!parent.MayContain(empty));
+ TEST(!child.MayContain(parent));
+ TEST(!parent.MayContain(sibling));
+}
+
+void TestAddFunctionsAndMap() {
+ SymbolFixture symbols;
+ const semantics::Symbol &symbol{symbols.MakeSymbol("f")};
+ DesignatorPath path;
+ TEST(path.empty());
+ path.AddComponent(symbol);
+ path.AddSubscripts({Scalar(1), Scalar(2)});
+ TEST(path.Parts().size() == 2);
+ TEST(path.Parts()[0].subscripts.empty());
+ TEST(path.Parts()[0].symbol == &symbol);
+ TEST(path.Parts()[1].subscripts.size() == 2);
+ TEST(path.Parts()[1].symbol == nullptr);
+
+ DesignatorPathMap<int> map;
+ TEST(map.empty());
+ map.push_back(path, 42);
+ TEST(!map.empty());
+ TEST(map.begin()->value == 42);
+ map.erase(map.begin());
+ TEST(map.empty());
+ map.push_back(DesignatorPath{}, 7);
+ map.clear();
+ TEST(map.empty());
+}
+
+void TestSubscriptsPrecedeComponentWithinPart() {
+ SymbolFixture symbols;
+ const semantics::Symbol &base{symbols.MakeSymbol("g")};
+ const semantics::Symbol &y{symbols.MakeSymbol("h")};
+ const semantics::Symbol &z{symbols.MakeSymbol("i")};
+
+ DesignatorPath x;
+ x.SetBase(NamedEntity{base});
+ TEST(x.Base().has_value());
+ TEST(x.Parts().empty());
+
+ DesignatorPath differentBase;
+ differentBase.SetBase(NamedEntity{y});
+
+ DesignatorPath xFull;
+ xFull.SetBase(NamedEntity{base});
+ xFull.AddSubscripts({FullSection()});
+ TEST(xFull.Parts().size() == 1);
+ TEST(xFull.Parts()[0].subscripts.size() == 1);
+ TEST(xFull.Parts()[0].subscripts[0] == FullSection());
+ const auto *fullTriplet{
+ std::get_if<Triplet>(&xFull.Parts()[0].subscripts[0].u)};
+ TEST(fullTriplet != nullptr);
+ if (fullTriplet) {
+ TEST(!fullTriplet->GetLower());
+ TEST(!fullTriplet->GetUpper());
+ TEST(DesignatorPath::IsFullTriplet(*fullTriplet));
+ }
+ TEST(xFull.Parts()[0].symbol == nullptr);
+ TEST(!(xFull == x));
+ TEST(x.Compare(xFull) == DesignatorRelation::Equal);
+ TEST(xFull.Compare(x) == DesignatorRelation::Equal);
+ TEST(x.MayContain(xFull));
+ TEST(xFull.MayContain(x));
+ TEST(!xFull.MayContain(differentBase));
+
+ DesignatorPath xSection;
+ xSection.SetBase(NamedEntity{base});
+ xSection.AddSubscripts({Section(1, 10)});
+ TEST(xSection.Base().has_value());
+ TEST(xSection.Parts().size() == 1);
+ TEST(xSection.Parts()[0].subscripts.size() == 1);
+ TEST(xSection.Parts()[0].symbol == nullptr);
+
+ DesignatorPath xSectionY;
+ xSectionY.SetBase(NamedEntity{base});
+ xSectionY.AddSubscripts({Section(1, 10)});
+ xSectionY.AddComponent(y);
+ TEST(xSectionY.Parts().size() == 1);
+ TEST(xSectionY.Parts()[0].subscripts.size() == 1);
+ TEST(xSectionY.Parts()[0].symbol == &y);
+
+ DesignatorPath xSectionYFull{xSectionY};
+ xSectionYFull.AddSubscripts({FullSection()});
+ TEST(xSectionYFull.Parts().size() == 2);
+ TEST(xSectionYFull.Parts()[0].subscripts.size() == 1);
+ TEST(xSectionYFull.Parts()[0].symbol == &y);
+ TEST(xSectionYFull.Parts()[1].subscripts.size() == 1);
+ TEST(xSectionYFull.Parts()[1].subscripts[0] == FullSection());
+ TEST(xSectionYFull.Parts()[1].symbol == nullptr);
+ TEST(!(xSectionYFull == xSectionY));
+ TEST(xSectionYFull.Compare(xSectionY) == DesignatorRelation::Equal);
+ TEST(xSectionY.Compare(xSectionYFull) == DesignatorRelation::Equal);
+ TEST(xSectionYFull.MayContain(xSectionY));
+ TEST(xSectionY.MayContain(xSectionYFull));
+
+ DesignatorPath xSectionYFullZ;
+ xSectionYFullZ.SetBase(NamedEntity{base});
+ xSectionYFullZ.AddSubscripts({Section(1, 10)});
+ xSectionYFullZ.AddComponent(y);
+ xSectionYFullZ.AddSubscripts({FullSection()});
+ xSectionYFullZ.AddComponent(z);
+ TEST(xSectionYFullZ.Parts().size() == 2);
+ TEST(xSectionYFullZ.Parts()[0].subscripts.size() == 1);
+ TEST(xSectionYFullZ.Parts()[0].symbol == &y);
+ TEST(xSectionYFullZ.Parts()[1].subscripts.size() == 1);
+ TEST(xSectionYFullZ.Parts()[1].subscripts[0] == FullSection());
+ TEST(xSectionYFullZ.Parts()[1].symbol == &z);
+}
+
+void TestAsFortran() {
+ SymbolFixture symbols;
+ const semantics::Symbol &a{symbols.MakeSymbol("a")};
+ const semantics::Symbol &x{symbols.MakeSymbol("x")};
+ const semantics::Symbol &y{symbols.MakeSymbol("y")};
+ DesignatorPath path;
+ path.SetBase(NamedEntity{a});
+ TEST(path.AsFortran() == "a");
+ path.AddSubscripts({Scalar(1), Section(2, 4)});
+ TEST(path.AsFortran() == "a(1_8,2_8:4_8:1_8)");
+ path.AddComponent(x);
+ TEST(path.AsFortran() == "a(1_8,2_8:4_8:1_8)%x");
+ path.AddSubscripts({FullSection()});
+ path.AddComponent(y);
+ TEST(path.AsFortran() == "a(1_8,2_8:4_8:1_8)%x(::1_8)%y");
+}
+
+} // namespace
+
+int main() {
+ TestGetConstantSubscriptRange();
+ TestFullTripletDetection();
+ TestCompareSubscripts();
+ TestCompareSubscriptLists();
+ TestCompareParts();
+ TestCombineRelations();
+ TestComparePaths();
+ TestMayContainSubscripts();
+ TestMayContainPartsAndPaths();
+ TestAddFunctionsAndMap();
+ TestSubscriptsPrecedeComponentWithinPart();
+ TestAsFortran();
+ return testing::Complete();
+}
>From 4ead7683788b7ef45eac96d9bcedf49791c7546e Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Wed, 26 Aug 2026 18:55:19 -0700
Subject: [PATCH 02/10] [flang] Preserve implied-do index identity in
expression analysis
---
flang/lib/Semantics/expression.cpp | 13 ++++++++
flang/test/Lower/OpenACC/implied-do-index.f90 | 33 +++++++++++++++++++
2 files changed, 46 insertions(+)
create mode 100644 flang/test/Lower/OpenACC/implied-do-index.f90
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index ef2ae91d88a86e..1a1fc0647f3fce 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1155,6 +1155,19 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Name &n) {
// performs the same check explicitly when returning a saved typed
// expression, since that path does not call Analyze(Name).
WarnForNumericStorageSize(context_, n);
+ // Name resolution gives array constructor and DATA implied-do indices
+ // their own scope. Preserve that identity when an expression is analyzed
+ // by a fresh ExpressionAnalyzer without the active implied-do context.
+ // Other names referenced in an implied-do may have host-associated
+ // symbols owned by the same scope; only its local object is the index.
+ if (n.symbol->has<semantics::ObjectEntityDetails>() &&
+ semantics::IsImpliedDoIndex(*n.symbol)) {
+ if (std::optional<DynamicType> type{DynamicType::From(*n.symbol)};
+ type && type->category() == TypeCategory::Integer) {
+ return AsMaybeExpr(ConvertToKind<TypeCategory::Integer>(
+ type->kind(), AsExpr(ImpliedDoIndex{n.source})));
+ }
+ }
const Symbol &ultimate{n.symbol->GetUltimate()};
if (ultimate.has<semantics::TypeParamDetails>()) {
// A bare reference to a derived type parameter within a parameterized
diff --git a/flang/test/Lower/OpenACC/implied-do-index.f90 b/flang/test/Lower/OpenACC/implied-do-index.f90
new file mode 100644
index 00000000000000..6be90af477e9c8
--- /dev/null
+++ b/flang/test/Lower/OpenACC/implied-do-index.f90
@@ -0,0 +1,33 @@
+! RUN: bbc -fopenacc -emit-hlfir %s -o - | FileCheck %s
+
+! Exercise an array-constructor implied-do index after the OpenACC semantics
+! pass has analyzed an enclosing array subscript. The enclosing declaration
+! with the same name must not turn the implied-do index into a SymbolRef.
+subroutine implied_do_index_host(a, x, n)
+ integer :: n
+ integer :: a(n, n), x(n), i
+
+ x = [(sum(a(:, i)), i = 1, n)]
+end subroutine
+
+! CHECK-LABEL: func.func @_QPimplied_do_index_host
+! CHECK: hlfir.elemental
+! CHECK: %[[HOST_INDEX:.*]] = fir.convert %{{.*}} : (index) -> i64
+! CHECK-NEXT: %[[HOST_KIND:.*]] = fir.convert %[[HOST_INDEX]] : (i64) -> i32
+! CHECK-NEXT: %[[HOST_SUBSCRIPT:.*]] = fir.convert %[[HOST_KIND]] : (i32) -> i64
+! CHECK: hlfir.designate {{.*}}%[[HOST_SUBSCRIPT]]
+
+! Preserve the explicit kind of an implied-do index when its resolved symbol,
+! rather than an active ExpressionAnalyzer entry, identifies the index.
+subroutine implied_do_index_kind8(a, x, n)
+ integer :: n
+ integer :: a(n, n), x(n), i
+
+ x = [(sum(a(:, i)), integer(8) :: i = 1, n)]
+end subroutine
+
+! CHECK-LABEL: func.func @_QPimplied_do_index_kind8
+! CHECK: hlfir.elemental
+! CHECK: %[[KIND8_INDEX:.*]] = fir.convert %{{.*}} : (index) -> i64
+! CHECK-NOT: fir.convert %[[KIND8_INDEX]]
+! CHECK: hlfir.designate {{.*}}%[[KIND8_INDEX]]
>From 927adf6224318440f9643763f8f2e43f788dd885 Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Mon, 31 Aug 2026 13:26:31 -0700
Subject: [PATCH 03/10] [flang][OpenACC] Test invalid loop and kernels clauses
---
.../OpenACC/acc-invalid-clause-placement.f90 | 36 +++++++++++++++++++
1 file changed, 36 insertions(+)
create mode 100644 flang/test/Semantics/OpenACC/acc-invalid-clause-placement.f90
diff --git a/flang/test/Semantics/OpenACC/acc-invalid-clause-placement.f90 b/flang/test/Semantics/OpenACC/acc-invalid-clause-placement.f90
new file mode 100644
index 00000000000000..bb87ad775d1b2d
--- /dev/null
+++ b/flang/test/Semantics/OpenACC/acc-invalid-clause-placement.f90
@@ -0,0 +1,36 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenacc
+
+subroutine data_clauses_on_loop(a, p)
+ real :: a(10)
+ real, pointer :: p
+ integer :: i
+
+ !ERROR: COPY clause is not allowed on the LOOP directive
+ !ERROR: COPYIN clause is not allowed on the LOOP directive
+ !ERROR: COPYOUT clause is not allowed on the LOOP directive
+ !ERROR: CREATE clause is not allowed on the LOOP directive
+ !ERROR: NO_CREATE clause is not allowed on the LOOP directive
+ !ERROR: PRESENT clause is not allowed on the LOOP directive
+ !$acc loop copy(a) copyin(a) copyout(a) create(a) no_create(a) present(a)
+ do i = 1, 10
+ a(i) = real(i)
+ end do
+
+ !ERROR: DEVICEPTR clause is not allowed on the LOOP directive
+ !ERROR: ATTACH clause is not allowed on the LOOP directive
+ !ERROR: DELETE clause is not allowed on the LOOP directive
+ !ERROR: DETACH clause is not allowed on the LOOP directive
+ !$acc loop deviceptr(p) attach(p) delete(a) detach(p)
+ do i = 1, 10
+ a(i) = real(i)
+ end do
+end subroutine
+
+subroutine reduction_on_kernels(x)
+ integer :: x
+
+ !ERROR: REDUCTION clause is not allowed on the KERNELS directive
+ !$acc kernels reduction(+:x)
+ x = x + 1
+ !$acc end kernels
+end subroutine
>From d27e57c82af8ca318bd73654241b74d7ec78fcaa Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Mon, 31 Aug 2026 13:37:07 -0700
Subject: [PATCH 04/10] [flang][OpenACC] Reject incompatible array data-sharing
clauses
---
flang/lib/Semantics/resolve-directives.cpp | 41 ++++++++++++--
.../OpenACC/acc-component-ref-dsa.f90 | 17 +++++-
.../OpenACC/acc-dataclause-dedup.f90 | 53 +++++++++++++------
3 files changed, 91 insertions(+), 20 deletions(-)
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 3f4536240b5007..ec0b8f7346bacb 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2327,6 +2327,32 @@ Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
return &object;
}
+static bool HaveSameAccDataSharingEntity(
+ const DesignatorPath &x, const DesignatorPath &y) {
+ if (x.Base().has_value() != y.Base().has_value() ||
+ (x.Base() && !(*x.Base() == *y.Base()))) {
+ return false;
+ }
+ auto xIter{x.Parts().begin()};
+ auto yIter{y.Parts().begin()};
+ while (true) {
+ while (xIter != x.Parts().end() && !xIter->symbol) {
+ ++xIter;
+ }
+ while (yIter != y.Parts().end() && !yIter->symbol) {
+ ++yIter;
+ }
+ if (xIter == x.Parts().end() || yIter == y.Parts().end()) {
+ return xIter == x.Parts().end() && yIter == y.Parts().end();
+ }
+ if (xIter->symbol != yIter->symbol) {
+ return false;
+ }
+ ++xIter;
+ ++yIter;
+ }
+}
+
bool AccAttributeVisitor::CheckClauseConsistencyInCurrentConstruct(
const parser::Name &name, Symbol::Flag accFlag, DesignatorPath designator,
const parser::AccObject *occurrence, bool warnSameKindDuplicate) {
@@ -2340,7 +2366,8 @@ bool AccAttributeVisitor::CheckClauseConsistencyInCurrentConstruct(
for (auto iter{objectsWithDSA.begin()}; iter != objectsWithDSA.end();) {
AccDataSharingEntry &entry{iter->value};
DesignatorRelation relation{iter->path.Compare(designator)};
- if (relation == DesignatorRelation::Disjoint) {
+ if (relation == DesignatorRelation::Disjoint &&
+ !HaveSameAccDataSharingEntity(iter->path, designator)) {
++iter;
continue;
}
@@ -2388,8 +2415,16 @@ bool AccAttributeVisitor::CheckClauseConsistencyInCurrentConstruct(
}
return false;
}
- case DesignatorRelation::Disjoint:
- llvm_unreachable("disjoint relation handled above");
+ case DesignatorRelation::Disjoint: {
+ auto &message{context_.Say(source,
+ "'%s' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive"_err_en_US,
+ displayName)};
+ if (entry.occurrence) {
+ message.Attach(parser::FindSourceLocation(*entry.occurrence),
+ "previous data-sharing object appears here"_en_US);
+ }
+ return false;
+ }
}
}
objectsWithDSA.push_back(std::move(designator), {accFlag, occurrence});
diff --git a/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90 b/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90
index 6f5534aca38edc..0306a5aa58e27e 100644
--- a/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90
+++ b/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90
@@ -123,6 +123,13 @@ subroutine test_same_object_incompatible_different_components()
p%y = p%x
end do
!$acc end parallel loop
+
+ !$acc parallel loop firstprivate(p%y) private(p%x)
+ do i = 1, 10
+ p%x = real(i)
+ p%y = p%x
+ end do
+ !$acc end parallel loop
end subroutine
subroutine test_contained_component_same_dsa()
@@ -196,13 +203,21 @@ subroutine test_distinct_objects_same_type_same_component()
!$acc end parallel loop
end subroutine
-subroutine test_indexed_component_refs_are_not_conflicts()
+subroutine test_indexed_component_refs_conflict()
use component_ref_types, only: vec_t
type(vec_t) :: v
integer :: i
+ !ERROR: 'v%arr(6:10)' appears in more than one data-sharing clause on the same OpenACC directive
!$acc parallel loop private(v%arr(1:5)) firstprivate(v%arr(6:10))
do i = 1, 10
v%arr(i) = real(i)
end do
!$acc end parallel loop
+
+ !ERROR: 'v%arr(1:5)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop firstprivate(v%arr(6:10)) private(v%arr(1:5))
+ do i = 1, 10
+ v%arr(i) = real(i)
+ end do
+ !$acc end parallel loop
end subroutine
diff --git a/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90 b/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90
index 143f99f5d34b46..0a69fde055cecc 100644
--- a/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90
+++ b/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90
@@ -110,35 +110,49 @@ program test_dataclause_dedup
end type
type(pt) :: s
- ! Different array elements -- not duplicates.
+ ! Distinct elements of one array still represent the same data-sharing
+ ! entity and cannot be lowered as separate private operands.
+ !ERROR: 'arr(2)' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive
!$acc parallel loop private(arr(1), arr(2))
do i = 1, 10
end do
- ! Different array sections -- not duplicates.
+ !ERROR: 'arr(6:10)' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive
!$acc parallel loop private(arr(1:5), arr(6:10))
do i = 1, 10
end do
- ! Different array elements in different data-sharing clauses -- not
- ! duplicates.
+ ! Different array elements in different data-sharing clauses conflict.
+ !ERROR: 'arr(2)' appears in more than one data-sharing clause on the same OpenACC directive
!$acc parallel loop private(arr(1)) firstprivate(arr(2))
do i = 1, 10
end do
- ! Different array sections in different data-sharing clauses -- not
- ! duplicates.
+ ! Reversing the clause order does not change the entity-level conflict.
+ !ERROR: 'arr(1)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop firstprivate(arr(2)) private(arr(1))
+ do i = 1, 10
+ end do
+
+ !ERROR: 'arr(6:10)' appears in more than one data-sharing clause on the same OpenACC directive
!$acc parallel loop private(arr(1:5)) firstprivate(arr(6:10))
do i = 1, 10
end do
+ !ERROR: 'arr(1:5)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop firstprivate(arr(6:10)) private(arr(1:5))
+ do i = 1, 10
+ end do
+
! A literal element outside a literal section is disjoint across
- ! data-sharing kinds.
+ ! data-sharing kinds but still belongs to the same array entity.
+ !ERROR: 'arr(6)' appears in more than one data-sharing clause on the same OpenACC directive
!$acc parallel loop private(arr(1:5)) firstprivate(arr(6))
do i = 1, 10
end do
- ! Named constant sections that fold to disjoint ranges are not conflicts.
+ ! Named constant sections that fold to disjoint ranges still conflict.
+ !ERROR: 'arr(split+1:right)' appears in more than one data-sharing clause on the same OpenACC directive
!$acc parallel loop private(arr(left:split)) firstprivate(arr(split+1:right))
do i = 1, 10
end do
@@ -217,14 +231,15 @@ program test_dataclause_dedup
do i = 1, 10
end do
- ! Variable index/section containment cannot yet be proven, so it is treated
- ! as disjoint.
+ ! Variable index/section containment cannot be proven, so separate
+ ! appearances of the same array entity are rejected.
+ !ERROR: 'arr(lo:hi)' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive
!$acc parallel loop private(arr(idx), arr(lo:hi))
do i = 1, 10
end do
- ! Variable index/section overlap is ambiguous, so assume disjoint across
- ! data-sharing kinds unless overlap can be proven.
+ ! Variable index/section overlap is ambiguous across data-sharing kinds.
+ !ERROR: 'arr(idx)' appears in more than one data-sharing clause on the same OpenACC directive
!$acc parallel loop private(arr(lo:hi)) firstprivate(arr(idx))
do i = 1, 10
end do
@@ -235,18 +250,24 @@ program test_dataclause_dedup
do i = 1, 10
end do
- ! Variable section overlap cannot yet be proven, so it is treated as
- ! disjoint.
+ ! Variable section overlap cannot be proven, so separate appearances of
+ ! the same array entity are rejected.
+ !ERROR: 'arr(mid:hi)' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive
!$acc parallel loop private(arr(lo:hi), arr(mid:hi))
do i = 1, 10
end do
- ! Variable section overlap is ambiguous, so assume disjoint across
- ! data-sharing kinds unless overlap can be proven.
+ ! Variable section overlap is ambiguous across data-sharing kinds.
+ !ERROR: 'arr(mid:hi)' appears in more than one data-sharing clause on the same OpenACC directive
!$acc parallel loop private(arr(lo:hi)) firstprivate(arr(mid:hi))
do i = 1, 10
end do
+ !ERROR: 'arr(lo:hi)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop firstprivate(arr(mid:hi)) private(arr(lo:hi))
+ do i = 1, 10
+ end do
+
! Identical variable sections conflict across data-sharing kinds.
!ERROR: 'arr(lo:hi)' appears in more than one data-sharing clause on the same OpenACC directive
!$acc parallel loop private(arr(lo:hi)) firstprivate(arr(lo:hi))
>From 6892fd922cd6c3dcd910df4a79d628fdd0a1381d Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Thu, 1 Oct 2026 12:31:00 -0700
Subject: [PATCH 05/10] [flang][OpenACC] Finalize clause objects before
checking conflicts
Collect explicit data-sharing objects across the complete directive before diagnosing conflicts. Drop equal and contained same-kind objects first, so a whole object subsumes earlier sections regardless of clause order.
Keep implicit loop privatization checks separate and remove redundant occurrences from the visible data-sharing set. Cover contained components, both whole-array/section orders, and whole arrays following multiple unknown selectors in semantics and lowering tests.
---
flang/lib/Semantics/resolve-directives.cpp | 277 ++++++++++++------
.../test/Lower/OpenACC/acc-dedup-private.f90 | 46 +++
.../OpenACC/acc-component-ref-dsa.f90 | 4 +-
.../OpenACC/acc-dataclause-dedup.f90 | 51 +++-
4 files changed, 284 insertions(+), 94 deletions(-)
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index ec0b8f7346bacb..a4142c9906f98f 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -187,7 +187,9 @@ class AccAttributeVisitor {
llvm::acc::Directive directive;
Scope &scope;
Symbol::Flag defaultDSA{Symbol::Flag::AccShared};
+ DesignatorPathMap<AccDataSharingEntry> clauseObjects;
DesignatorPathMap<AccDataSharingEntry> objectsWithDSA;
+ bool clauseObjectsFinalized{false};
bool withinConstruct{false};
std::int64_t associatedLoopLevel{0};
};
@@ -229,14 +231,14 @@ class AccAttributeVisitor {
bool Pre(const parser::OpenACCCombinedConstruct &);
void Post(const parser::OpenACCCombinedConstruct &) { PopAccContext(); }
void Post(const parser::AccBeginCombinedDirective &) {
- GetContext().withinConstruct = true;
+ FinishAccDirectiveHeader();
}
bool Pre(const parser::OpenACCDeclarativeConstruct &);
void Post(const parser::OpenACCDeclarativeConstruct &) { PopAccContext(); }
void Post(const parser::AccDeclarativeDirective &) {
- GetContext().withinConstruct = true;
+ FinishAccDirectiveHeader();
}
bool Pre(const parser::OpenACCRoutineConstruct &);
@@ -244,14 +246,12 @@ class AccAttributeVisitor {
void Post(const parser::OpenACCStandaloneDeclarativeConstruct &);
void Post(const parser::AccBeginBlockDirective &) {
- GetContext().withinConstruct = true;
+ FinishAccDirectiveHeader();
}
bool Pre(const parser::OpenACCLoopConstruct &);
void Post(const parser::OpenACCLoopConstruct &) { PopAccContext(); }
- void Post(const parser::AccLoopDirective &) {
- GetContext().withinConstruct = true;
- }
+ void Post(const parser::AccLoopDirective &) { FinishAccDirectiveHeader(); }
// TODO: We should probably also privatize ConcurrentBounds.
template <typename A>
@@ -259,7 +259,7 @@ class AccAttributeVisitor {
if (!dirContext_.empty() && GetContext().withinConstruct) {
if (auto *symbol{DeclareOrMarkOtherAccessEntity(
x.Name().thing, Symbol::Flag::AccPrivate)}) {
- CheckClauseConsistencyInCurrentConstruct(x.Name().thing,
+ CheckImplicitClauseConsistencyInCurrentConstruct(x.Name().thing,
Symbol::Flag::AccPrivate, MakeBaseDesignatorPath(*symbol));
}
}
@@ -269,7 +269,7 @@ class AccAttributeVisitor {
bool Pre(const parser::OpenACCStandaloneConstruct &);
void Post(const parser::OpenACCStandaloneConstruct &) { PopAccContext(); }
void Post(const parser::AccStandaloneDirective &) {
- GetContext().withinConstruct = true;
+ FinishAccDirectiveHeader();
}
bool Pre(const parser::OpenACCWaitConstruct &);
@@ -401,6 +401,8 @@ class AccAttributeVisitor {
void PushAccContext(const parser::CharBlock &, llvm::acc::Directive, Scope &);
void PushAccContext(const parser::CharBlock &, llvm::acc::Directive);
void PopAccContext();
+ void FinishAccDirectiveHeader();
+ void FinalizeAccClauseObjects();
static DesignatorPath MakeBaseDesignatorPath(const Symbol &);
bool IsObjectWithVisibleDSA(const DesignatorPath &) const;
void AdjustAccSymbolReference(const parser::Name &);
@@ -444,13 +446,12 @@ class AccAttributeVisitor {
Symbol *ResolveAccCommonBlockName(const parser::Name *);
Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
- // Called for explicit clause objects and implicit loop privatization.
- // Returns true iff the occurrence remains effective in the current OpenACC
- // construct; common-block processing uses false to stop expanding the block.
- bool CheckClauseConsistencyInCurrentConstruct(const parser::Name &,
- Symbol::Flag, DesignatorPath,
- const parser::AccObject *occurrence = nullptr,
- bool warnSameKindDuplicate = true);
+ void RecordAccClauseObject(
+ Symbol::Flag, DesignatorPath, const parser::AccObject *);
+ void RecordAccVisibleObject(
+ Symbol::Flag, DesignatorPath, const parser::AccObject *);
+ void CheckImplicitClauseConsistencyInCurrentConstruct(
+ const parser::Name &, Symbol::Flag, DesignatorPath);
void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList);
void DoNotAllowAssumedSizedArray(const parser::AccObjectList &objectList);
void AllowOnlyVariable(const parser::AccObject &object);
@@ -1934,9 +1935,15 @@ void AccAttributeVisitor::PushAccContext(
void AccAttributeVisitor::PopAccContext() {
CHECK(!dirContext_.empty());
+ FinalizeAccClauseObjects();
dirContext_.pop_back();
}
+void AccAttributeVisitor::FinishAccDirectiveHeader() {
+ FinalizeAccClauseObjects();
+ GetContext().withinConstruct = true;
+}
+
DesignatorPath AccAttributeVisitor::MakeBaseDesignatorPath(
const Symbol &symbol) {
DesignatorPath path;
@@ -2248,8 +2255,8 @@ void AccAttributeVisitor::ResolveAccObject(
if (canCheckMultipleAppearances) {
const parser::Name &baseName{parser::GetFirstName(designator)};
if (baseName.symbol && !designatorPath.empty()) {
- CheckClauseConsistencyInCurrentConstruct(
- baseName, accFlag, std::move(designatorPath), &accObject);
+ RecordAccClauseObject(
+ accFlag, std::move(designatorPath), &accObject);
}
}
return;
@@ -2272,17 +2279,15 @@ void AccAttributeVisitor::ResolveAccObject(
context_.NoteOpenACCDataMapping();
}
if (canCheckMultipleAppearances && !designatorPath.empty()) {
- CheckClauseConsistencyInCurrentConstruct(
- baseName, accFlag, std::move(designatorPath), &accObject);
+ RecordAccClauseObject(
+ accFlag, std::move(designatorPath), &accObject);
}
}
},
[&](const parser::Name &name) { // common block
if (auto *symbol{ResolveAccCommonBlockName(&name)}) {
- if (!CheckClauseConsistencyInCurrentConstruct(name, accFlag,
- MakeBaseDesignatorPath(*symbol), &accObject)) {
- return;
- }
+ RecordAccClauseObject(
+ accFlag, MakeBaseDesignatorPath(*symbol), &accObject);
// Members of a named COMMON listed in a data clause are not
// recorded as device-mapped. Lowering does not create an
// alternate device binding for them, so CUDA generic resolution
@@ -2291,7 +2296,7 @@ void AccAttributeVisitor::ResolveAccObject(
for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
if (auto *resolvedObject{
DeclareOrMarkOtherAccessEntity(*object, accFlag)}) {
- CheckClauseConsistencyInCurrentConstruct(name, accFlag,
+ RecordAccVisibleObject(accFlag,
MakeBaseDesignatorPath(*resolvedObject), &accObject);
}
}
@@ -2353,82 +2358,188 @@ static bool HaveSameAccDataSharingEntity(
}
}
-bool AccAttributeVisitor::CheckClauseConsistencyInCurrentConstruct(
- const parser::Name &name, Symbol::Flag accFlag, DesignatorPath designator,
- const parser::AccObject *occurrence, bool warnSameKindDuplicate) {
+void AccAttributeVisitor::RecordAccVisibleObject(Symbol::Flag accFlag,
+ DesignatorPath designator, const parser::AccObject *occurrence) {
if (designator.empty()) {
- return false;
+ return;
}
- const parser::CharBlock source{
- occurrence ? parser::FindSourceLocation(*occurrence) : name.source};
- const std::string displayName{source.ToString()};
- auto &objectsWithDSA{GetContext().objectsWithDSA};
- for (auto iter{objectsWithDSA.begin()}; iter != objectsWithDSA.end();) {
- AccDataSharingEntry &entry{iter->value};
- DesignatorRelation relation{iter->path.Compare(designator)};
- if (relation == DesignatorRelation::Disjoint &&
- !HaveSameAccDataSharingEntity(iter->path, designator)) {
- ++iter;
- continue;
- }
+ GetContext().objectsWithDSA.push_back(
+ std::move(designator), {accFlag, occurrence});
+}
- if (!(dataSharingAttributeFlags.test(entry.flag) &&
- dataSharingAttributeFlags.test(accFlag))) {
- ++iter;
+void AccAttributeVisitor::RecordAccClauseObject(Symbol::Flag accFlag,
+ DesignatorPath designator, const parser::AccObject *occurrence) {
+ if (designator.empty()) {
+ return;
+ }
+ GetContext().clauseObjects.push_back(designator, {accFlag, occurrence});
+ RecordAccVisibleObject(accFlag, std::move(designator), occurrence);
+}
+
+void AccAttributeVisitor::FinalizeAccClauseObjects() {
+ AccDirContext &context{GetContext()};
+ if (context.clauseObjectsFinalized) {
+ return;
+ }
+ context.clauseObjectsFinalized = true;
+
+ auto &clauseObjects{context.clauseObjects};
+ const std::size_t count{static_cast<std::size_t>(
+ std::distance(clauseObjects.begin(), clauseObjects.end()))};
+ std::vector<std::optional<DesignatorRelation>> redundant(count);
+
+ // First find objects made redundant by an equal or containing object with
+ // the same data-sharing attribute. This pass sees the complete directive,
+ // so a later whole-object occurrence can subsume earlier unknown sections
+ // before those sections are compared with one another.
+ for (std::size_t i{0}; i < count; ++i) {
+ const auto &entry{*(clauseObjects.begin() + i)};
+ if (!dataSharingAttributeFlags.test(entry.value.flag) ||
+ entry.value.flag == Symbol::Flag::AccReduction) {
continue;
}
-
- // TODO: Record the reduction operator in AccDataSharingEntry so compatible
- // reductions can use the ordinary same-kind duplicate handling. Also handle
- // private/reduction interactions on loop constructs.
- if (entry.flag != accFlag || accFlag == Symbol::Flag::AccReduction) {
- auto &message{context_.Say(source,
- "'%s' appears in more than one data-sharing clause on the same OpenACC directive"_err_en_US,
- displayName)};
- if (entry.occurrence) {
- message.Attach(parser::FindSourceLocation(*entry.occurrence),
- "previous data-sharing object appears here"_en_US);
+ for (std::size_t j{0}; j < count; ++j) {
+ if (i == j) {
+ continue;
+ }
+ const auto &other{*(clauseObjects.begin() + j)};
+ if (entry.value.flag != other.value.flag) {
+ continue;
+ }
+ DesignatorRelation relation{entry.path.Compare(other.path)};
+ if (relation == DesignatorRelation::ContainedBy) {
+ redundant[i] = relation;
+ break;
+ }
+ if (relation == DesignatorRelation::Equal && j < i) {
+ redundant[i] = relation;
}
- return false;
}
+ }
- switch (relation) {
- case DesignatorRelation::Equal:
- if (warnSameKindDuplicate && occurrence) {
+ for (std::size_t i{0}; i < count; ++i) {
+ if (!redundant[i]) {
+ continue;
+ }
+ const AccDataSharingEntry &entry{(clauseObjects.begin() + i)->value};
+ if (entry.occurrence) {
+ const parser::CharBlock source{
+ parser::FindSourceLocation(*entry.occurrence)};
+ if (*redundant[i] == DesignatorRelation::Equal) {
context_.Warn(common::UsageWarning::OpenAccUsage, source,
"'%s' appears more than once in the same kind of data-sharing clause on an OpenACC directive; duplicate ignored"_warn_en_US,
- displayName);
- context_.MarkAccObjectDuplicate(occurrence);
+ source.ToString());
+ } else {
+ context_.Warn(common::UsageWarning::OpenAccUsage, source,
+ "'%s' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored"_warn_en_US,
+ source.ToString());
}
- return false;
- case DesignatorRelation::Contains:
- case DesignatorRelation::ContainedBy:
- case DesignatorRelation::Overlaps: {
- // TODO: Support non-identical same-kind objects once their containment
- // and overlap semantics are defined.
- auto &message{context_.Say(source,
- "'%s' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive"_err_en_US,
- displayName)};
- if (entry.occurrence) {
- message.Attach(parser::FindSourceLocation(*entry.occurrence),
- "previous data-sharing object appears here"_en_US);
+ context_.MarkAccObjectDuplicate(entry.occurrence);
+ }
+ }
+
+ for (std::size_t i{count}; i-- > 0;) {
+ if (redundant[i]) {
+ clauseObjects.erase(clauseObjects.begin() + i);
+ }
+ }
+ for (auto iter{context.objectsWithDSA.begin()};
+ iter != context.objectsWithDSA.end();) {
+ if (iter->value.occurrence &&
+ context_.IsAccObjectDuplicate(iter->value.occurrence)) {
+ iter = context.objectsWithDSA.erase(iter);
+ } else {
+ ++iter;
+ }
+ }
+
+ // Diagnose only the maximal surviving paths. Any pair that was rendered
+ // harmless by a containing occurrence has already been removed above.
+ const std::size_t survivorCount{static_cast<std::size_t>(
+ std::distance(clauseObjects.begin(), clauseObjects.end()))};
+ for (std::size_t i{0}; i < survivorCount; ++i) {
+ const auto &entry{*(clauseObjects.begin() + i)};
+ if (!dataSharingAttributeFlags.test(entry.value.flag)) {
+ continue;
+ }
+ for (std::size_t j{0}; j < i; ++j) {
+ const auto &previous{*(clauseObjects.begin() + j)};
+ if (!dataSharingAttributeFlags.test(previous.value.flag)) {
+ continue;
}
- return false;
+ DesignatorRelation relation{previous.path.Compare(entry.path)};
+ if (relation == DesignatorRelation::Disjoint &&
+ !HaveSameAccDataSharingEntity(previous.path, entry.path)) {
+ continue;
+ }
+
+ // TODO: Record the reduction operator in AccDataSharingEntry so
+ // compatible reductions can use ordinary same-kind duplicate handling.
+ // Also handle private/reduction interactions on loop constructs.
+ const parser::CharBlock source{
+ parser::FindSourceLocation(*entry.value.occurrence)};
+ auto emitError{[&](const parser::MessageFixedText &text) {
+ auto &message{context_.Say(source, text, source.ToString())};
+ if (previous.value.occurrence) {
+ message.Attach(parser::FindSourceLocation(*previous.value.occurrence),
+ "previous data-sharing object appears here"_en_US);
+ }
+ }};
+ if (previous.value.flag != entry.value.flag ||
+ entry.value.flag == Symbol::Flag::AccReduction) {
+ emitError(
+ "'%s' appears in more than one data-sharing clause on the same OpenACC directive"_err_en_US);
+ } else if (relation == DesignatorRelation::Overlaps) {
+ emitError(
+ "'%s' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive"_err_en_US);
+ } else if (relation == DesignatorRelation::Disjoint) {
+ emitError(
+ "'%s' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive"_err_en_US);
+ } else {
+ llvm_unreachable("equal and contained same-kind objects were removed");
+ }
+ break;
+ }
+ }
+}
+
+void AccAttributeVisitor::CheckImplicitClauseConsistencyInCurrentConstruct(
+ const parser::Name &name, Symbol::Flag accFlag, DesignatorPath designator) {
+ if (designator.empty()) {
+ return;
+ }
+ CHECK(GetContext().clauseObjectsFinalized);
+ for (const auto &entry : GetContext().clauseObjects) {
+ DesignatorRelation relation{entry.path.Compare(designator)};
+ if (relation == DesignatorRelation::Disjoint &&
+ !HaveSameAccDataSharingEntity(entry.path, designator)) {
+ continue;
+ }
+ if (!(dataSharingAttributeFlags.test(entry.value.flag) &&
+ dataSharingAttributeFlags.test(accFlag))) {
+ continue;
}
- case DesignatorRelation::Disjoint: {
- auto &message{context_.Say(source,
- "'%s' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive"_err_en_US,
- displayName)};
- if (entry.occurrence) {
- message.Attach(parser::FindSourceLocation(*entry.occurrence),
+ auto emitError{[&](const parser::MessageFixedText &text) {
+ auto &message{context_.Say(name.source, text, name.ToString())};
+ if (entry.value.occurrence) {
+ message.Attach(parser::FindSourceLocation(*entry.value.occurrence),
"previous data-sharing object appears here"_en_US);
}
- return false;
- }
+ }};
+ if (entry.value.flag != accFlag || accFlag == Symbol::Flag::AccReduction) {
+ emitError(
+ "'%s' appears in more than one data-sharing clause on the same OpenACC directive"_err_en_US);
+ } else if (relation == DesignatorRelation::Overlaps) {
+ emitError(
+ "'%s' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive"_err_en_US);
+ } else if (relation == DesignatorRelation::Disjoint) {
+ emitError(
+ "'%s' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive"_err_en_US);
}
+ return;
}
- objectsWithDSA.push_back(std::move(designator), {accFlag, occurrence});
- return true;
+ GetContext().clauseObjects.push_back(designator, {accFlag, nullptr});
+ RecordAccVisibleObject(accFlag, std::move(designator), nullptr);
}
#ifndef NDEBUG
diff --git a/flang/test/Lower/OpenACC/acc-dedup-private.f90 b/flang/test/Lower/OpenACC/acc-dedup-private.f90
index 68fe9297ee0562..aa6b3999ada299 100644
--- a/flang/test/Lower/OpenACC/acc-dedup-private.f90
+++ b/flang/test/Lower/OpenACC/acc-dedup-private.f90
@@ -61,3 +61,49 @@ subroutine test_firstprivate_pair(i)
! CHECK-LABEL: func.func @_QPtest_firstprivate_pair
! CHECK: acc.firstprivate varPtr({{.*}}) recipe(@firstprivatization_ref_i32) name("x") -> !fir.ref<i32>
! CHECK-NOT: acc.firstprivate varPtr({{.*}}) recipe(@firstprivatization_ref_i32) name("x") -> !fir.ref<i32>
+
+! -----------------------------------------------------------------------
+! A contained private object is dropped in favor of its containing object.
+
+subroutine test_private_contained_after(i)
+ real :: a(10)
+ integer :: i
+ !$acc parallel loop private(a) private(a(1:5))
+ do i = 1, 10
+ end do
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_private_contained_after
+! CHECK: acc.private varPtr({{.*}}) recipe(@privatization_ref_10xf32) name("a") -> !fir.ref<!fir.array<10xf32>>
+! CHECK-NOT: name("a(1:5)")
+
+! -----------------------------------------------------------------------
+! Source order does not affect which object is retained.
+
+subroutine test_private_contained_before(i)
+ real :: a(10)
+ integer :: i
+ !$acc parallel loop private(a(1:5)) private(a)
+ do i = 1, 10
+ end do
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_private_contained_before
+! CHECK: acc.private varPtr({{.*}}) recipe(@privatization_ref_10xf32) name("a") -> !fir.ref<!fir.array<10xf32>>
+! CHECK-NOT: name("a(1:5)")
+
+! -----------------------------------------------------------------------
+! A trailing whole array subsumes multiple unknown selectors before those
+! selectors are diagnosed as distinct parts of the same array.
+
+subroutine test_private_container_last(a, i, j, k)
+ real :: a(10)
+ integer :: i, j, k
+ !$acc parallel loop private(a(i), a(j)) private(a)
+ do k = 1, 10
+ end do
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_private_container_last
+! CHECK: acc.private varPtr({{.*}}) recipe(@privatization_ref_10xf32) name("a") -> !fir.ref<!fir.array<10xf32>>
+! CHECK-NOT: name("a({{.*}})")
diff --git a/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90 b/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90
index 0306a5aa58e27e..14865e7d4e56b3 100644
--- a/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90
+++ b/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90
@@ -136,7 +136,7 @@ subroutine test_contained_component_same_dsa()
use component_ref_types, only: nested_t
type(nested_t) :: n
integer :: i
- !ERROR: 'n%pt%x' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive
+ !WARNING: 'n%pt%x' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
!$acc parallel loop private(n%pt, n%pt%x)
do i = 1, 10
n%pt%x = real(i)
@@ -148,7 +148,7 @@ subroutine test_contained_component_same_dsa_child_first()
use component_ref_types, only: nested_t
type(nested_t) :: n
integer :: i
- !ERROR: 'n%pt' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive
+ !WARNING: 'n%pt%x' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
!$acc parallel loop private(n%pt%x, n%pt)
do i = 1, 10
n%pt%x = real(i)
diff --git a/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90 b/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90
index 0a69fde055cecc..062b80ce88fb3e 100644
--- a/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90
+++ b/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90
@@ -3,9 +3,10 @@
! Same-kind data-sharing duplicates on an OpenACC directive (e.g.
! private(x, x), private(x) private(x), copyin(x, x) ...) are not errors:
! resolve-directives warns and rewrite-parse-tree drops the duplicate
-! occurrences from the clause object lists. Cross-kind duplicates
-! (e.g. private(x) firstprivate(x)) and reduction duplicates remain
-! hard errors.
+! occurrences from the clause object lists. When one same-kind object contains
+! another, the contained occurrence is likewise dropped. Cross-kind
+! duplicates (e.g. private(x) firstprivate(x)), partial overlaps, disjoint
+! parts of one array, and reduction duplicates remain hard errors.
program test_dataclause_dedup
implicit none
@@ -213,14 +214,14 @@ program test_dataclause_dedup
do i = 1, 10
end do
- ! A section and its contained element are likewise rejected in either
- ! order until precise containment support is implemented.
- !ERROR: 'arr(3)' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive
+ ! A contained object is redundant in the same data-sharing kind. Keep the
+ ! containing object and ignore the contained occurrence in either order.
+ !WARNING: 'arr(3)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
!$acc parallel loop private(arr(1:5), arr(3))
do i = 1, 10
end do
- !ERROR: 'arr(1:5)' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive
+ !WARNING: 'arr(3)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
!$acc parallel loop private(arr(3), arr(1:5))
do i = 1, 10
end do
@@ -279,11 +280,43 @@ program test_dataclause_dedup
do i = 1, 10
end do
- ! A whole array and an element are not distinct data-sharing objects.
- !ERROR: 'arr(1)' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive
+ ! A whole array contains an element, so only the whole-array occurrence is
+ ! retained.
+ !WARNING: 'arr(1)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
!$acc parallel loop private(arr, arr(1))
do i = 1, 10
end do
+
+ ! Eugene's whole-array/proper-subset example, in both source orders.
+ !WARNING: 'arr(1:5)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc parallel private(arr) private(arr(1:5))
+ arr(9) = 1
+ !$acc end parallel
+
+ !WARNING: 'arr(1:5)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc parallel private(arr(1:5)) private(arr)
+ arr(9) = 1
+ !$acc end parallel
+
+ ! All contained occurrences are removed before the remaining paths are
+ ! compared, so unknown selectors behave uniformly in every source order.
+ !WARNING: 'arr(idx)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !WARNING: 'arr(mid)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc parallel private(arr(idx), arr(mid)) private(arr)
+ arr(9) = 1
+ !$acc end parallel
+
+ !WARNING: 'arr(idx)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !WARNING: 'arr(mid)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc parallel private(arr(idx)) private(arr) private(arr(mid))
+ arr(9) = 1
+ !$acc end parallel
+
+ !WARNING: 'arr(idx)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !WARNING: 'arr(mid)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc parallel private(arr) private(arr(idx), arr(mid))
+ arr(9) = 1
+ !$acc end parallel
end block
end program
>From 0d9a8a510d331922cb42b95fdaf3fad0c079b3e4 Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Thu, 1 Oct 2026 14:31:48 -0700
Subject: [PATCH 06/10] [flang][OpenACC] Finalize clauses after complete
directive headers
Finalize standalone loop objects in Post(AccBeginLoopDirective), after the clause list and before the associated DO construct. The directive-name callback ran before the clauses and prevented duplicate and conflict checks from running.
Move declarative and standalone finalization to their enclosing construct callbacks as well. Cover duplicate lowering, private/reduction conflicts in both orders, whole-array containment permutations, and implicit loop-index consistency.
---
flang/lib/Semantics/resolve-directives.cpp | 13 ++---
.../test/Lower/OpenACC/acc-dedup-private.f90 | 54 ++++++++++++++++++
.../OpenACC/acc-loop-clause-finalization.f90 | 56 +++++++++++++++++++
3 files changed, 116 insertions(+), 7 deletions(-)
create mode 100644 flang/test/Semantics/OpenACC/acc-loop-clause-finalization.f90
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index a4142c9906f98f..6d04f001dd997c 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -237,10 +237,6 @@ class AccAttributeVisitor {
bool Pre(const parser::OpenACCDeclarativeConstruct &);
void Post(const parser::OpenACCDeclarativeConstruct &) { PopAccContext(); }
- void Post(const parser::AccDeclarativeDirective &) {
- FinishAccDirectiveHeader();
- }
-
bool Pre(const parser::OpenACCRoutineConstruct &);
bool Pre(const parser::AccBindClause &);
void Post(const parser::OpenACCStandaloneDeclarativeConstruct &);
@@ -251,7 +247,9 @@ class AccAttributeVisitor {
bool Pre(const parser::OpenACCLoopConstruct &);
void Post(const parser::OpenACCLoopConstruct &) { PopAccContext(); }
- void Post(const parser::AccLoopDirective &) { FinishAccDirectiveHeader(); }
+ void Post(const parser::AccBeginLoopDirective &) {
+ FinishAccDirectiveHeader();
+ }
// TODO: We should probably also privatize ConcurrentBounds.
template <typename A>
@@ -267,9 +265,9 @@ class AccAttributeVisitor {
}
bool Pre(const parser::OpenACCStandaloneConstruct &);
- void Post(const parser::OpenACCStandaloneConstruct &) { PopAccContext(); }
- void Post(const parser::AccStandaloneDirective &) {
+ void Post(const parser::OpenACCStandaloneConstruct &) {
FinishAccDirectiveHeader();
+ PopAccContext();
}
bool Pre(const parser::OpenACCWaitConstruct &);
@@ -1334,6 +1332,7 @@ static const parser::AccObjectList &GetAccObjectList(
void AccAttributeVisitor::Post(
const parser::OpenACCStandaloneDeclarativeConstruct &x) {
+ FinishAccDirectiveHeader();
const auto &clauseList = std::get<parser::AccClauseList>(x.t);
for (const auto &clause : clauseList.v) {
// Restriction - line 2414
diff --git a/flang/test/Lower/OpenACC/acc-dedup-private.f90 b/flang/test/Lower/OpenACC/acc-dedup-private.f90
index aa6b3999ada299..c96cfb41cd3c0f 100644
--- a/flang/test/Lower/OpenACC/acc-dedup-private.f90
+++ b/flang/test/Lower/OpenACC/acc-dedup-private.f90
@@ -107,3 +107,57 @@ subroutine test_private_container_last(a, i, j, k)
! CHECK-LABEL: func.func @_QPtest_private_container_last
! CHECK: acc.private varPtr({{.*}}) recipe(@privatization_ref_10xf32) name("a") -> !fir.ref<!fir.array<10xf32>>
! CHECK-NOT: name("a({{.*}})")
+
+! -----------------------------------------------------------------------
+! Standalone LOOP headers finalize their clauses before the loop body.
+
+subroutine test_standalone_private_pair()
+ integer :: x, i
+ !$acc parallel
+ !$acc loop private(x, x)
+ do i = 1, 10
+ x = i
+ end do
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_standalone_private_pair
+! CHECK: acc.private varPtr({{.*}}) recipe(@privatization_ref_i32) name("x") -> !fir.ref<i32>
+! CHECK-NOT: acc.private {{.*}} name("x")
+! CHECK: acc.loop
+
+subroutine test_standalone_private_container_last(a, i, j)
+ real :: a(10)
+ integer :: i, j, k
+ !$acc parallel
+ !$acc loop private(a(i), a(j)) private(a)
+ do k = 1, 10
+ a(k) = real(k)
+ end do
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_standalone_private_container_last
+! CHECK-NOT: acc.private {{.*}} name("a({{.*}})")
+! CHECK: acc.private varPtr({{.*}}) recipe(@privatization_ref_10xf32) name("a") -> !fir.ref<!fir.array<10xf32>>
+! CHECK-NOT: acc.private {{.*}} name("a")
+! CHECK-NOT: acc.private {{.*}} name("a({{.*}})")
+! CHECK: acc.loop
+
+subroutine test_standalone_private_container_first(a, i, j)
+ real :: a(10)
+ integer :: i, j, k
+ !$acc parallel
+ !$acc loop private(a) private(a(i), a(j))
+ do k = 1, 10
+ a(k) = real(k)
+ end do
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_standalone_private_container_first
+! CHECK-NOT: acc.private {{.*}} name("a({{.*}})")
+! CHECK: acc.private varPtr({{.*}}) recipe(@privatization_ref_10xf32) name("a") -> !fir.ref<!fir.array<10xf32>>
+! CHECK-NOT: acc.private {{.*}} name("a")
+! CHECK-NOT: acc.private {{.*}} name("a({{.*}})")
+! CHECK: acc.loop
diff --git a/flang/test/Semantics/OpenACC/acc-loop-clause-finalization.f90 b/flang/test/Semantics/OpenACC/acc-loop-clause-finalization.f90
new file mode 100644
index 00000000000000..05c8d47562ca68
--- /dev/null
+++ b/flang/test/Semantics/OpenACC/acc-loop-clause-finalization.f90
@@ -0,0 +1,56 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenacc
+
+! Standalone LOOP clauses must be finalized after the complete header and
+! before visiting the associated DO construct.
+subroutine loop_clause_finalization(a, i, j)
+ integer :: a(10), i, j, k, x
+ !$acc parallel
+
+ !WARNING: 'x' appears more than once in the same kind of data-sharing clause on an OpenACC directive; duplicate ignored [-Wopenacc-usage]
+ !$acc loop private(x, x)
+ do k = 1, 10
+ x = k
+ end do
+
+ !ERROR: 'x' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc loop private(x) reduction(+:x)
+ do k = 1, 10
+ x = x + k
+ end do
+
+ !ERROR: 'x' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc loop reduction(+:x) private(x)
+ do k = 1, 10
+ x = x + k
+ end do
+
+ !WARNING: 'a(i)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !WARNING: 'a(j)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc loop private(a(i), a(j)) private(a)
+ do k = 1, 10
+ a(k) = k
+ end do
+
+ !WARNING: 'a(i)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !WARNING: 'a(j)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc loop private(a(i)) private(a) private(a(j))
+ do k = 1, 10
+ a(k) = k
+ end do
+
+ !WARNING: 'a(i)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !WARNING: 'a(j)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc loop private(a) private(a(i), a(j))
+ do k = 1, 10
+ a(k) = k
+ end do
+
+ ! Explicit clauses are finalized before implicit loop-index privatization.
+ !$acc loop reduction(+:k)
+ !ERROR: 'k' appears in more than one data-sharing clause on the same OpenACC directive
+ do k = 1, 10
+ x = k
+ end do
+
+ !$acc end parallel
+end subroutine
>From cc28dbb2bd3cc864ab8c33668b69c775e39349a3 Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Thu, 1 Oct 2026 15:21:49 -0700
Subject: [PATCH 07/10] [flang][OpenACC] Account for COMMON blocks in
designator comparisons
Track the enclosing COMMON block on designator paths so whole-block data-sharing objects contain their members, sections, and components. Diagnose block/member conflicts after complete clause collection and remove redundant member operands independently of clause order.
Protect entries without a source occurrence from redundancy removal, while retaining duplicate handling for explicit whole-block clauses. Add semantic, lowering, and designator comparison tests.
---
.../include/flang/Evaluate/designator-path.h | 7 +-
flang/lib/Evaluate/designator-path.cpp | 32 ++-
flang/lib/Semantics/resolve-directives.cpp | 3 +-
.../Lower/OpenACC/acc-common-member-dedup.f90 | 149 ++++++++++++++
.../OpenACC/acc-common-member-dsa.f90 | 192 ++++++++++++++++++
flang/unittests/Evaluate/designator-path.cpp | 73 +++++++
6 files changed, 453 insertions(+), 3 deletions(-)
create mode 100644 flang/test/Lower/OpenACC/acc-common-member-dedup.f90
create mode 100644 flang/test/Semantics/OpenACC/acc-common-member-dsa.f90
diff --git a/flang/include/flang/Evaluate/designator-path.h b/flang/include/flang/Evaluate/designator-path.h
index d81334b75bcde2..c0780b6dc6e9de 100644
--- a/flang/include/flang/Evaluate/designator-path.h
+++ b/flang/include/flang/Evaluate/designator-path.h
@@ -59,11 +59,14 @@ struct DesignatorPath {
void AddComponent(const Symbol &);
void AddSubscripts(std::vector<Subscript>);
const std::optional<NamedEntity> &Base() const { return base; }
+ // The enclosing COMMON block, or nullptr when the base is not in COMMON.
+ const Symbol *CommonBlock() const { return commonBlock; }
const std::vector<Part> &Parts() const { return parts; }
bool empty() const { return !base && parts.empty(); }
bool HasBaseOnly() const { return base && parts.empty(); }
bool operator==(const DesignatorPath &that) const {
- return base == that.base && parts == that.parts;
+ return base == that.base && commonBlock == that.commonBlock &&
+ parts == that.parts;
}
struct ConstantSubscriptRange {
@@ -87,6 +90,7 @@ struct DesignatorPath {
static bool PartMayContain(const Part &, const Part &);
private:
+ bool IsWholeCommonBlock() const;
void AddDataRef(const DataRef &);
void AddComponent(const Component &);
void AddNamedEntity(const NamedEntity &);
@@ -94,6 +98,7 @@ struct DesignatorPath {
void AddCoarrayRef(const CoarrayRef &);
std::optional<NamedEntity> base;
+ const Symbol *commonBlock{nullptr};
std::vector<Part> parts;
};
diff --git a/flang/lib/Evaluate/designator-path.cpp b/flang/lib/Evaluate/designator-path.cpp
index 8c498cf010b4f8..66f3177ce40a14 100644
--- a/flang/lib/Evaluate/designator-path.cpp
+++ b/flang/lib/Evaluate/designator-path.cpp
@@ -9,6 +9,7 @@
#include "flang/Evaluate/designator-path.h"
#include "flang/Evaluate/fold.h"
#include "flang/Evaluate/tools.h"
+#include "flang/Semantics/symbol.h"
#include "llvm/Support/ErrorHandling.h"
#include "llvm/Support/raw_ostream.h"
@@ -274,6 +275,15 @@ DesignatorRelation DesignatorPath::Compare(const DesignatorPath &that) const {
if (empty() || that.empty()) {
return DesignatorRelation::Disjoint;
}
+ if (commonBlock && commonBlock == that.commonBlock) {
+ if (IsWholeCommonBlock()) {
+ return that.IsWholeCommonBlock() ? DesignatorRelation::Equal
+ : DesignatorRelation::Contains;
+ }
+ if (that.IsWholeCommonBlock()) {
+ return DesignatorRelation::ContainedBy;
+ }
+ }
if (base || that.base) {
if (!base || !that.base || !(*base == *that.base)) {
return DesignatorRelation::Disjoint;
@@ -325,6 +335,9 @@ bool DesignatorPath::MayContain(const DesignatorPath &that) const {
if (*this == that || empty()) {
return true;
}
+ if (commonBlock && commonBlock == that.commonBlock && IsWholeCommonBlock()) {
+ return true;
+ }
if (base || that.base) {
if (!base || !that.base || !(*base == *that.base)) {
return false;
@@ -379,7 +392,24 @@ llvm::raw_ostream &DesignatorPath::AsFortran(llvm::raw_ostream &o) const {
return o;
}
-void DesignatorPath::SetBase(NamedEntity entity) { base = std::move(entity); }
+bool DesignatorPath::IsWholeCommonBlock() const {
+ return commonBlock && HasBaseOnly() && base->IsSymbol() &&
+ &base->GetFirstSymbol().GetUltimate() == commonBlock;
+}
+
+void DesignatorPath::SetBase(NamedEntity entity) {
+ base = std::move(entity);
+ commonBlock = nullptr;
+ const Symbol &symbol{base->GetFirstSymbol().GetUltimate()};
+ if (symbol.has<semantics::CommonBlockDetails>()) {
+ commonBlock = &symbol;
+ } else if (const auto *details{
+ symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
+ if (const Symbol *block{details->commonBlock()}) {
+ commonBlock = &block->GetUltimate();
+ }
+ }
+}
void DesignatorPath::AddComponent(const Symbol &symbol) {
if (!parts.empty() && !parts.back().symbol) {
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 6d04f001dd997c..243f5aa6992955 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2393,7 +2393,8 @@ void AccAttributeVisitor::FinalizeAccClauseObjects() {
// before those sections are compared with one another.
for (std::size_t i{0}; i < count; ++i) {
const auto &entry{*(clauseObjects.begin() + i)};
- if (!dataSharingAttributeFlags.test(entry.value.flag) ||
+ if (!entry.value.occurrence ||
+ !dataSharingAttributeFlags.test(entry.value.flag) ||
entry.value.flag == Symbol::Flag::AccReduction) {
continue;
}
diff --git a/flang/test/Lower/OpenACC/acc-common-member-dedup.f90 b/flang/test/Lower/OpenACC/acc-common-member-dedup.f90
new file mode 100644
index 00000000000000..d65df7aec6724d
--- /dev/null
+++ b/flang/test/Lower/OpenACC/acc-common-member-dedup.f90
@@ -0,0 +1,149 @@
+! RUN: bbc -fopenacc -emit-hlfir %s -o - 2>/dev/null | FileCheck %s
+
+! Retain the whole COMMON operand and drop redundant explicit members.
+
+subroutine private_block_first()
+ integer :: a, b
+ common /blk/ a, b
+ !$acc parallel private(/blk/) private(a)
+ a = b + 1
+ b = a + 1
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPprivate_block_first
+! CHECK-NOT: acc.private {{.*}} name("a")
+! CHECK-NOT: acc.private {{.*}} name("b")
+! CHECK: %[[BLOCK:.*]] = acc.private {{.*}} name("blk") -> !fir.ref<!fir.array<8xi8>>
+! CHECK-NOT: acc.private {{.*}} name("a")
+! CHECK-NOT: acc.private {{.*}} name("b")
+! CHECK-NOT: acc.private {{.*}} name("blk")
+! CHECK: acc.parallel{{.*}} private(%[[BLOCK]] : !fir.ref<!fir.array<8xi8>>) {
+! CHECK-NOT: acc.private
+! CHECK: hlfir.assign
+! CHECK: hlfir.assign
+! CHECK: acc.yield
+
+subroutine private_member_first()
+ integer :: a, b
+ common /blk/ a, b
+ !$acc parallel private(a) private(/blk/)
+ a = b + 1
+ b = a + 1
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPprivate_member_first
+! CHECK-NOT: acc.private {{.*}} name("a")
+! CHECK-NOT: acc.private {{.*}} name("b")
+! CHECK: %[[BLOCK:.*]] = acc.private {{.*}} name("blk") -> !fir.ref<!fir.array<8xi8>>
+! CHECK-NOT: acc.private {{.*}} name("a")
+! CHECK-NOT: acc.private {{.*}} name("b")
+! CHECK-NOT: acc.private {{.*}} name("blk")
+! CHECK: acc.parallel{{.*}} private(%[[BLOCK]] : !fir.ref<!fir.array<8xi8>>) {
+! CHECK-NOT: acc.private
+! CHECK: hlfir.assign
+! CHECK: hlfir.assign
+! CHECK: acc.yield
+
+subroutine private_members_first()
+ integer :: a, b
+ common /blk/ a, b
+ !$acc parallel private(a, b) private(/blk/)
+ a = b + 1
+ b = a + 1
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPprivate_members_first
+! CHECK-NOT: acc.private {{.*}} name("a")
+! CHECK-NOT: acc.private {{.*}} name("b")
+! CHECK: %[[BLOCK:.*]] = acc.private {{.*}} name("blk") -> !fir.ref<!fir.array<8xi8>>
+! CHECK-NOT: acc.private {{.*}} name("a")
+! CHECK-NOT: acc.private {{.*}} name("b")
+! CHECK-NOT: acc.private {{.*}} name("blk")
+! CHECK: acc.parallel{{.*}} private(%[[BLOCK]] : !fir.ref<!fir.array<8xi8>>) {
+! CHECK-NOT: acc.private
+! CHECK: hlfir.assign
+! CHECK: hlfir.assign
+! CHECK: acc.yield
+
+subroutine firstprivate_block_first()
+ integer :: a, b
+ common /blk/ a, b
+ !$acc parallel firstprivate(/blk/) firstprivate(a)
+ a = b + 1
+ b = a + 1
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPfirstprivate_block_first
+! CHECK-NOT: acc.firstprivate {{.*}} name("a")
+! CHECK-NOT: acc.firstprivate {{.*}} name("b")
+! CHECK: %[[BLOCK:.*]] = acc.firstprivate {{.*}} name("blk") -> !fir.ref<!fir.array<8xi8>>
+! CHECK-NOT: acc.firstprivate {{.*}} name("a")
+! CHECK-NOT: acc.firstprivate {{.*}} name("b")
+! CHECK-NOT: acc.firstprivate {{.*}} name("blk")
+! CHECK: acc.parallel{{.*}} firstprivate(%[[BLOCK]] : !fir.ref<!fir.array<8xi8>>) {
+! CHECK-NOT: acc.firstprivate
+! CHECK: hlfir.assign
+! CHECK: hlfir.assign
+! CHECK: acc.yield
+
+subroutine firstprivate_member_first()
+ integer :: a, b
+ common /blk/ a, b
+ !$acc parallel firstprivate(a) firstprivate(/blk/)
+ a = b + 1
+ b = a + 1
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPfirstprivate_member_first
+! CHECK-NOT: acc.firstprivate {{.*}} name("a")
+! CHECK-NOT: acc.firstprivate {{.*}} name("b")
+! CHECK: %[[BLOCK:.*]] = acc.firstprivate {{.*}} name("blk") -> !fir.ref<!fir.array<8xi8>>
+! CHECK-NOT: acc.firstprivate {{.*}} name("a")
+! CHECK-NOT: acc.firstprivate {{.*}} name("b")
+! CHECK-NOT: acc.firstprivate {{.*}} name("blk")
+! CHECK: acc.parallel{{.*}} firstprivate(%[[BLOCK]] : !fir.ref<!fir.array<8xi8>>) {
+! CHECK-NOT: acc.firstprivate
+! CHECK: hlfir.assign
+! CHECK: hlfir.assign
+! CHECK: acc.yield
+
+subroutine repeated_whole_common()
+ integer :: a, b
+ common /blk/ a, b
+ !$acc parallel private(/blk/) private(/blk/)
+ a = b + 1
+ b = a + 1
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPrepeated_whole_common
+! CHECK: %[[BLOCK:.*]] = acc.private {{.*}} name("blk") -> !fir.ref<!fir.array<8xi8>>
+! CHECK-NOT: acc.private {{.*}} name("blk")
+! CHECK: acc.parallel{{.*}} private(%[[BLOCK]] : !fir.ref<!fir.array<8xi8>>) {
+! CHECK: hlfir.assign
+! CHECK: hlfir.assign
+! CHECK: acc.yield
+
+subroutine common_array_container_last(i, j)
+ integer :: a(10), b, i, j
+ common /array_blk/ a, b
+ !$acc parallel private(a(i), a(j)) private(/array_blk/)
+ a(9) = b + 1
+ b = a(9) + 1
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPcommon_array_container_last
+! CHECK-NOT: acc.private {{.*}} name("a{{.*}}")
+! CHECK: %[[BLOCK:.*]] = acc.private {{.*}} name("array_blk") -> !fir.ref<!fir.array<44xi8>>
+! CHECK-NOT: acc.private
+! CHECK: acc.parallel{{.*}} private(%[[BLOCK]] : !fir.ref<!fir.array<44xi8>>) {
+! CHECK-NOT: acc.private
+! CHECK: hlfir.assign
+! CHECK: hlfir.assign
+! CHECK: acc.yield
diff --git a/flang/test/Semantics/OpenACC/acc-common-member-dsa.f90 b/flang/test/Semantics/OpenACC/acc-common-member-dsa.f90
new file mode 100644
index 00000000000000..3239cd374a240a
--- /dev/null
+++ b/flang/test/Semantics/OpenACC/acc-common-member-dsa.f90
@@ -0,0 +1,192 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenacc
+
+! COMMON-block members participate in clause conflicts and containment.
+
+subroutine block_private_member_firstprivate()
+ integer :: a, b
+ common /blk/ a, b
+ !ERROR: 'a' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel private(/blk/) firstprivate(a)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine member_firstprivate_block_private()
+ integer :: a, b
+ common /blk/ a, b
+ !ERROR: 'blk' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel firstprivate(a) private(/blk/)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine block_firstprivate_member_private()
+ integer :: a, b
+ common /blk/ a, b
+ !ERROR: 'a' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel firstprivate(/blk/) private(a)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine member_private_block_firstprivate()
+ integer :: a, b
+ common /blk/ a, b
+ !ERROR: 'blk' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel private(a) firstprivate(/blk/)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine block_private_member_private()
+ integer :: a, b
+ common /blk/ a, b
+ !WARNING: 'a' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc parallel private(/blk/) private(a)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine member_private_block_private()
+ integer :: a, b
+ common /blk/ a, b
+ !WARNING: 'a' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc parallel private(a) private(/blk/)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine block_firstprivate_member_firstprivate()
+ integer :: a, b
+ common /blk/ a, b
+ !WARNING: 'a' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc parallel firstprivate(/blk/) firstprivate(a)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine member_firstprivate_block_firstprivate()
+ integer :: a, b
+ common /blk/ a, b
+ !WARNING: 'a' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc parallel firstprivate(a) firstprivate(/blk/)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine all_members_before_block()
+ integer :: a, b
+ common /blk/ a, b
+ !WARNING: 'a' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !WARNING: 'b' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc parallel private(a, b) private(/blk/)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine all_members_after_block()
+ integer :: a, b
+ common /blk/ a, b
+ !WARNING: 'a' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !WARNING: 'b' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc parallel private(/blk/) private(a, b)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine common_firstprivate_loop_index()
+ integer :: a, b
+ common /blk/ a, b
+ !$acc parallel loop firstprivate(/blk/)
+ !ERROR: 'a' appears in more than one data-sharing clause on the same OpenACC directive
+ do a = 1, 10
+ b = a
+ end do
+end subroutine
+
+subroutine common_private_loop_index()
+ integer :: a, b
+ common /blk/ a, b
+ !$acc parallel loop private(/blk/)
+ do a = 1, 10
+ b = a
+ end do
+end subroutine
+
+subroutine common_member_section_conflict()
+ integer :: a(10), b
+ common /blk/ a, b
+ !ERROR: 'a(1:5)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel private(/blk/) firstprivate(a(1:5))
+ a(1) = b
+ !$acc end parallel
+end subroutine
+
+subroutine distinct_common_members()
+ integer :: a, b
+ common /blk/ a, b
+ !$acc parallel private(a) firstprivate(b)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine distinct_common_blocks()
+ integer :: a, b
+ common /blk1/ a
+ common /blk2/ b
+ !$acc parallel private(/blk1/) firstprivate(/blk2/)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine common_data_action_and_dsa()
+ integer :: a, b
+ common /blk/ a, b
+ !$acc parallel copy(/blk/) private(a)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine repeated_whole_common()
+ integer :: a, b
+ common /blk/ a, b
+ !WARNING: 'blk' appears more than once in the same kind of data-sharing clause on an OpenACC directive; duplicate ignored [-Wopenacc-usage]
+ !$acc parallel private(/blk/) private(/blk/)
+ a = b
+ !$acc end parallel
+end subroutine
+
+subroutine common_container_last(i, j)
+ integer :: a(10), b, i, j
+ common /blk/ a, b
+ !WARNING: 'a(i)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !WARNING: 'a(j)' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored [-Wopenacc-usage]
+ !$acc parallel private(a(i), a(j)) private(/blk/)
+ a(9) = b
+ !$acc end parallel
+end subroutine
+
+subroutine common_component_conflict()
+ type :: pair
+ sequence
+ integer :: a, b
+ end type
+ type(pair) :: p
+ common /blk/ p
+ !ERROR: 'p%a' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel private(/blk/) firstprivate(p%a)
+ p%a = p%b
+ !$acc end parallel
+end subroutine
+
+module common_host_association
+ integer :: a, b
+ common /host_blk/ a, b
+contains
+ subroutine host_associated_member_conflict()
+ !ERROR: 'a' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel private(/host_blk/) firstprivate(a)
+ a = b
+ !$acc end parallel
+ end subroutine
+end module
diff --git a/flang/unittests/Evaluate/designator-path.cpp b/flang/unittests/Evaluate/designator-path.cpp
index 60ab4fbe0a0477..7e9812a7bb8732 100644
--- a/flang/unittests/Evaluate/designator-path.cpp
+++ b/flang/unittests/Evaluate/designator-path.cpp
@@ -68,6 +68,26 @@ class SymbolFixture {
semantics::UnknownDetails{});
}
+ semantics::Symbol &MakeCommonBlock(const char *name) {
+ return scope_.MakeSymbol(parser::CharBlock{name}, semantics::Attrs{},
+ semantics::CommonBlockDetails{parser::CharBlock{name}});
+ }
+
+ const semantics::Symbol &MakeCommonMember(
+ const char *name, semantics::Symbol &block) {
+ auto &symbol{scope_.MakeSymbol(parser::CharBlock{name}, semantics::Attrs{},
+ semantics::ObjectEntityDetails{})};
+ symbol.get<semantics::ObjectEntityDetails>().set_commonBlock(block);
+ block.get<semantics::CommonBlockDetails>().add_object(symbol);
+ return symbol;
+ }
+
+ const semantics::Symbol &MakeHostAssociated(
+ const char *name, const semantics::Symbol &symbol) {
+ return scope_.MakeSymbol(parser::CharBlock{name}, semantics::Attrs{},
+ semantics::HostAssocDetails{symbol});
+ }
+
private:
parser::AllSources allSources_;
parser::AllCookedSources allCookedSources_{allSources_};
@@ -373,6 +393,58 @@ void TestAsFortran() {
TEST(path.AsFortran() == "a(1_8,2_8:4_8:1_8)%x(::1_8)%y");
}
+void TestCommonBlockPaths() {
+ SymbolFixture symbols;
+ auto &block{symbols.MakeCommonBlock("blk")};
+ auto &otherBlock{symbols.MakeCommonBlock("other")};
+ const auto &a{symbols.MakeCommonMember("a", block)};
+ const auto &b{symbols.MakeCommonMember("b", block)};
+ const auto &c{symbols.MakeCommonMember("c", otherBlock)};
+ const auto &component{symbols.MakeSymbol("component")};
+ const auto &unrelated{symbols.MakeSymbol("unrelated")};
+ const auto &alias{symbols.MakeHostAssociated("alias", a)};
+
+ DesignatorPath wholeBlock, member, sibling, other, outside, hostAssociated;
+ wholeBlock.SetBase(NamedEntity{block});
+ member.SetBase(NamedEntity{a});
+ sibling.SetBase(NamedEntity{b});
+ other.SetBase(NamedEntity{c});
+ outside.SetBase(NamedEntity{unrelated});
+ hostAssociated.SetBase(NamedEntity{alias});
+ TEST(wholeBlock.CommonBlock() == &block);
+ TEST(member.CommonBlock() == &block);
+ TEST(hostAssociated.CommonBlock() == &block);
+ TEST(!outside.CommonBlock());
+
+ CheckRelation(wholeBlock, member, DesignatorRelation::Contains);
+ CheckRelation(member, wholeBlock, DesignatorRelation::ContainedBy);
+ CheckRelation(wholeBlock, hostAssociated, DesignatorRelation::Contains);
+ CheckRelation(member, sibling, DesignatorRelation::Disjoint);
+ CheckRelation(wholeBlock, other, DesignatorRelation::Disjoint);
+ CheckRelation(wholeBlock, outside, DesignatorRelation::Disjoint);
+ TEST(wholeBlock.MayContain(member));
+ TEST(!member.MayContain(wholeBlock));
+ TEST(!wholeBlock.MayContain(other));
+ TEST(!member.MayContain(sibling));
+
+ auto section{member};
+ section.AddSubscripts({Section(1, 5)});
+ auto subobject{member};
+ subobject.AddComponent(component);
+ CheckRelation(wholeBlock, section, DesignatorRelation::Contains);
+ CheckRelation(section, wholeBlock, DesignatorRelation::ContainedBy);
+ CheckRelation(wholeBlock, subobject, DesignatorRelation::Contains);
+ TEST(wholeBlock.MayContain(section));
+ TEST(wholeBlock.MayContain(subobject));
+ TEST(section.CommonBlock() == &block);
+
+ auto copied{wholeBlock};
+ TEST(copied == wholeBlock);
+ copied.SetBase(NamedEntity{unrelated});
+ TEST(!copied.CommonBlock());
+ CheckRelation(copied, member, DesignatorRelation::Disjoint);
+}
+
} // namespace
int main() {
@@ -388,5 +460,6 @@ int main() {
TestAddFunctionsAndMap();
TestSubscriptsPrecedeComponentWithinPart();
TestAsFortran();
+ TestCommonBlockPaths();
return testing::Complete();
}
>From 4d43c5d3740607ebf5e715f933dde261e4a13c4b Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Thu, 1 Oct 2026 16:37:19 -0700
Subject: [PATCH 08/10] [flang][OpenACC] Check source occurrence before
dereferencing
Use DEREF for the source occurrence required by explicit clause conflict diagnostics, making its non-null invariant explicit.
---
flang/lib/Semantics/resolve-directives.cpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 243f5aa6992955..046fa72e7b7292 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2477,7 +2477,7 @@ void AccAttributeVisitor::FinalizeAccClauseObjects() {
// compatible reductions can use ordinary same-kind duplicate handling.
// Also handle private/reduction interactions on loop constructs.
const parser::CharBlock source{
- parser::FindSourceLocation(*entry.value.occurrence)};
+ parser::FindSourceLocation(DEREF(entry.value.occurrence))};
auto emitError{[&](const parser::MessageFixedText &text) {
auto &message{context_.Say(source, text, source.ToString())};
if (previous.value.occurrence) {
>From 3688725ecc804f431f02591ef06b748137ea3216 Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Thu, 8 Oct 2026 13:38:40 -0700
Subject: [PATCH 09/10] [flang][OpenACC] Document clause analysis ordering and
comparison policy
---
flang/lib/Semantics/resolve-directives.cpp | 25 ++++++++++++++++++++++
1 file changed, 25 insertions(+)
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 046fa72e7b7292..892c5e0ae3bdd9 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -1938,6 +1938,8 @@ void AccAttributeVisitor::PopAccContext() {
dirContext_.pop_back();
}
+// Complete explicit-clause analysis before body references and implicit loop
+// attributes are checked against it.
void AccAttributeVisitor::FinishAccDirectiveHeader() {
FinalizeAccClauseObjects();
GetContext().withinConstruct = true;
@@ -2331,6 +2333,17 @@ Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
return &object;
}
+// DesignatorPath::Compare describes the relation between the selected parts of
+// objects, not whether OpenACC permits them in data-sharing clauses. For example,
+// a(1:5) and a(6:10) are Disjoint, but both select parts of the same data-sharing
+// entity and must still be checked for the multiple-appearance restriction.
+// Ignore array selectors here while retaining the base and component symbols:
+// sections of a%x identify the same entity, whereas a%x and a%y do not.
+// Keep this OpenACC policy separate from Compare. Making Compare report overlap
+// for disjoint sections would lose its structural meaning for other callers and
+// would conflate overlap diagnostics with the different-part diagnostic here.
+// Finalization also needs the actual equality and containment relations to prune
+// redundant same-kind objects before checking the surviving objects for conflicts.
static bool HaveSameAccDataSharingEntity(
const DesignatorPath &x, const DesignatorPath &y) {
if (x.Base().has_value() != y.Base().has_value() ||
@@ -2357,6 +2370,9 @@ static bool HaveSameAccDataSharingEntity(
}
}
+// Register coverage for body-reference checks without adding a clause-conflict
+// candidate. For example, a COMMON clause makes each member visible, but the
+// whole-block path represents the clause in conflict analysis.
void AccAttributeVisitor::RecordAccVisibleObject(Symbol::Flag accFlag,
DesignatorPath designator, const parser::AccObject *occurrence) {
if (designator.empty()) {
@@ -2366,6 +2382,8 @@ void AccAttributeVisitor::RecordAccVisibleObject(Symbol::Flag accFlag,
std::move(designator), {accFlag, occurrence});
}
+// Collect candidates without comparing them yet: a later containing object can
+// make earlier sections redundant and change which conflicts need diagnosing.
void AccAttributeVisitor::RecordAccClauseObject(Symbol::Flag accFlag,
DesignatorPath designator, const parser::AccObject *occurrence) {
if (designator.empty()) {
@@ -2375,6 +2393,10 @@ void AccAttributeVisitor::RecordAccClauseObject(Symbol::Flag accFlag,
RecordAccVisibleObject(accFlag, std::move(designator), occurrence);
}
+// Analyze the complete header in two phases: prune redundant same-kind objects,
+// then diagnose conflicts among survivors. Mark removed source occurrences so
+// lowering also ignores them. The guard permits both header completion and
+// context teardown to call this without repeating diagnostics.
void AccAttributeVisitor::FinalizeAccClauseObjects() {
AccDirContext &context{GetContext()};
if (context.clauseObjectsFinalized) {
@@ -2503,6 +2525,9 @@ void AccAttributeVisitor::FinalizeAccClauseObjects() {
}
}
+// Check implicit attributes against finalized clauses. New implicit entries have
+// no source occurrence: they participate in consistency and visibility checks,
+// but cannot be marked as removable clause objects.
void AccAttributeVisitor::CheckImplicitClauseConsistencyInCurrentConstruct(
const parser::Name &name, Symbol::Flag accFlag, DesignatorPath designator) {
if (designator.empty()) {
>From 32c26f6d48e70aab33729862f9ef9a09d3d3fd17 Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Thu, 8 Oct 2026 14:50:45 -0700
Subject: [PATCH 10/10] [flang][OpenACC] Address review findings in designator
path handling
DEFAULT(NONE):
- Check a single-element reference to an array component, `x%b(1)`. It is
still a function reference when OpenACC analysis runs, and its path was
never built, so the reference was not checked at all. Build the path from the
component and subscripts (rejecting procedure components), and check the base
object when a reference has no representable path.
- Make MayContain agree with Compare for a scalar element against a
one-element section, and decide containment exactly for constant strides.
- Do not fold an analyzed subscript a second time, which repeated a folding
warning without a source location.
Diagnostics:
- Report several parts of one object in the same kind of data-sharing clause as
not yet implemented. The message no longer claims that the parts are
separate, since Disjoint also stands for parts that cannot be compared.
- Share the conflict diagnostics between finalization and the implicit loop
index check.
Clean up:
- Make DesignatorPath a class, name its accessors per the style guide, and
remove the unused construction functions and the vector wrapper that was
called a map. Helpers used only by the unit test are now file local, and the
test checks Compare and MayContain through the public interface.
- Document that FinalizeAccClauseObjects is quadratic in the number of clause
objects, and how a POINTER member of a COMMON block listed beside the whole
block is lowered.
- Add tests for the cases above, a Lower test for a pointer member of a COMMON
block, and reversed clause orders for reductions. Loosen fragile Lower
checks, and stop pinning behavior that the test itself marks as wrong.
---
.../include/flang/Evaluate/designator-path.h | 87 ++--
flang/include/flang/Semantics/tools.h | 3 +
flang/lib/Evaluate/designator-path.cpp | 293 +++++++------
flang/lib/Semantics/resolve-directives.cpp | 300 +++++++-------
flang/lib/Semantics/tools.cpp | 56 ++-
.../Lower/OpenACC/acc-common-member-dedup.f90 | 2 +-
.../acc-common-pointer-member-dedup.f90 | 45 ++
.../test/Lower/OpenACC/acc-copy-reduction.f90 | 8 +-
.../test/Lower/OpenACC/acc-dedup-private.f90 | 4 +-
flang/test/Lower/OpenACC/implied-do-index.f90 | 4 +-
.../OpenACC/acc-component-ref-dsa.f90 | 24 +-
.../OpenACC/acc-dataclause-dedup.f90 | 66 ++-
.../OpenACC/acc-default-none-arrays.f90 | 53 +++
.../acc-default-none-component-elements.f90 | 136 +++++++
.../OpenACC/acc-subscript-folding-warning.f90 | 17 +
flang/unittests/Evaluate/designator-path.cpp | 384 ++++++++++--------
16 files changed, 927 insertions(+), 555 deletions(-)
create mode 100644 flang/test/Lower/OpenACC/acc-common-pointer-member-dedup.f90
create mode 100644 flang/test/Semantics/OpenACC/acc-default-none-component-elements.f90
create mode 100644 flang/test/Semantics/OpenACC/acc-subscript-folding-warning.f90
diff --git a/flang/include/flang/Evaluate/designator-path.h b/flang/include/flang/Evaluate/designator-path.h
index c0780b6dc6e9de..aa75f57b455dd7 100644
--- a/flang/include/flang/Evaluate/designator-path.h
+++ b/flang/include/flang/Evaluate/designator-path.h
@@ -10,14 +10,17 @@
#define FORTRAN_EVALUATE_DESIGNATOR_PATH_H_
#include "flang/Evaluate/expression.h"
-#include <cstdint>
+#include "llvm/Support/raw_ostream.h"
#include <optional>
#include <string>
-#include <utility>
#include <vector>
namespace Fortran::evaluate {
+// The relation between the parts of an object selected by two designators.
+// Disjoint is also the answer when two selections cannot be compared, for
+// example because a subscript is not constant or a triplet has a stride other
+// than one. It is therefore not a proof that the selections do not overlap.
enum class DesignatorRelation {
Equal,
Contains,
@@ -26,7 +29,8 @@ enum class DesignatorRelation {
Disjoint,
};
-struct DesignatorPath {
+class DesignatorPath {
+public:
// A DesignatorPath represents a constrained prefix of a valid Fortran
// designator:
// - an optional NamedEntity base, and
@@ -49,81 +53,36 @@ struct DesignatorPath {
}
};
- static std::optional<DesignatorPath> Get(
- const std::optional<Expr<SomeType>> &);
+ // Describes how the parts selected by this path relate to those selected by
+ // the other path.
DesignatorRelation Compare(const DesignatorPath &) const;
+ // Returns false only when this path certainly cannot cover the other path.
+ // It is optimistic where the two cannot be compared, and is used to avoid
+ // false DEFAULT(NONE) errors. A path that Compare reports as Equal to or as
+ // containing the other path always may contain it.
bool MayContain(const DesignatorPath &) const;
std::string AsFortran() const;
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
void SetBase(NamedEntity);
void AddComponent(const Symbol &);
void AddSubscripts(std::vector<Subscript>);
- const std::optional<NamedEntity> &Base() const { return base; }
+ const std::optional<NamedEntity> &base() const { return base_; }
// The enclosing COMMON block, or nullptr when the base is not in COMMON.
- const Symbol *CommonBlock() const { return commonBlock; }
- const std::vector<Part> &Parts() const { return parts; }
- bool empty() const { return !base && parts.empty(); }
- bool HasBaseOnly() const { return base && parts.empty(); }
+ const Symbol *commonBlock() const { return commonBlock_; }
+ const std::vector<Part> &parts() const { return parts_; }
+ bool empty() const { return !base_ && parts_.empty(); }
+ bool HasBaseOnly() const { return base_ && parts_.empty(); }
bool operator==(const DesignatorPath &that) const {
- return base == that.base && commonBlock == that.commonBlock &&
- parts == that.parts;
+ return base_ == that.base_ && commonBlock_ == that.commonBlock_ &&
+ parts_ == that.parts_;
}
- struct ConstantSubscriptRange {
- std::int64_t lower;
- std::int64_t upper;
- };
-
- static std::optional<ConstantSubscriptRange> GetConstantSubscriptRange(
- const Subscript &);
- static bool IsFullTriplet(const Triplet &);
- static DesignatorRelation CompareSubscripts(
- const Subscript &, const Subscript &);
- static DesignatorRelation CompareSubscriptLists(
- const std::vector<Subscript> &, const std::vector<Subscript> &);
- static DesignatorRelation CompareParts(const Part &, const Part &);
- static DesignatorRelation CombineRelations(
- bool contains, bool containedBy, bool overlaps);
- static bool SubscriptMayContain(const Subscript &, const Subscript &);
- static bool SubscriptListMayContain(
- const std::vector<Subscript> &, const std::vector<Subscript> &);
- static bool PartMayContain(const Part &, const Part &);
-
private:
bool IsWholeCommonBlock() const;
- void AddDataRef(const DataRef &);
- void AddComponent(const Component &);
- void AddNamedEntity(const NamedEntity &);
- void AddArrayRef(const ArrayRef &);
- void AddCoarrayRef(const CoarrayRef &);
-
- std::optional<NamedEntity> base;
- const Symbol *commonBlock{nullptr};
- std::vector<Part> parts;
-};
-template <typename A> class DesignatorPathMap {
-public:
- struct Entry {
- DesignatorPath path;
- A value;
- };
- using iterator = typename std::vector<Entry>::iterator;
- using const_iterator = typename std::vector<Entry>::const_iterator;
-
- iterator begin() { return entries_.begin(); }
- iterator end() { return entries_.end(); }
- const_iterator begin() const { return entries_.begin(); }
- const_iterator end() const { return entries_.end(); }
- bool empty() const { return entries_.empty(); }
- void clear() { entries_.clear(); }
- iterator erase(iterator iter) { return entries_.erase(iter); }
- void push_back(DesignatorPath path, A value) {
- entries_.push_back({std::move(path), std::move(value)});
- }
-
-private:
- std::vector<Entry> entries_;
+ std::optional<NamedEntity> base_;
+ const Symbol *commonBlock_{nullptr};
+ std::vector<Part> parts_;
};
} // namespace Fortran::evaluate
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 94a1ac0fd31054..e99c2c04f2e5fa 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -214,6 +214,9 @@ bool HasCoarray(const parser::Expr &);
// already-resolved base symbol and component structure, and analyzes and folds
// subscript expressions. Returns std::nullopt when the designator cannot be
// represented (e.g. an unresolved name or a non-integer/erroneous subscript).
+// Until the parse tree is rewritten, a subscripted array or array component
+// such as `a(i)` or `x%b(i)` is a FunctionReference, so that overload builds
+// the path for those and returns std::nullopt for a real procedure reference.
std::optional<evaluate::DesignatorPath> GetDesignatorPath(
SemanticsContext &, const parser::Designator &);
std::optional<evaluate::DesignatorPath> GetDesignatorPath(
diff --git a/flang/lib/Evaluate/designator-path.cpp b/flang/lib/Evaluate/designator-path.cpp
index 66f3177ce40a14..d9421bc7ee112b 100644
--- a/flang/lib/Evaluate/designator-path.cpp
+++ b/flang/lib/Evaluate/designator-path.cpp
@@ -7,14 +7,29 @@
//===----------------------------------------------------------------------===//
#include "flang/Evaluate/designator-path.h"
+#include "flang/Common/idioms.h"
#include "flang/Evaluate/fold.h"
#include "flang/Evaluate/tools.h"
#include "flang/Semantics/symbol.h"
-#include "llvm/Support/ErrorHandling.h"
-#include "llvm/Support/raw_ostream.h"
+#include <cstdint>
namespace Fortran::evaluate {
+namespace {
+// The values selected by a subscript with constant bounds and stride, as the
+// ascending arithmetic progression first, first + stride, ..., last.
+struct ConstantSection {
+ std::int64_t first;
+ std::int64_t last;
+ std::int64_t stride;
+};
+
+struct ConstantSubscriptRange {
+ std::int64_t lower;
+ std::int64_t upper;
+};
+} // namespace
+
static DesignatorRelation ComparePartSymbols(const Symbol *x, const Symbol *y) {
if (x == y) {
return DesignatorRelation::Equal;
@@ -28,13 +43,20 @@ static DesignatorRelation ComparePartSymbols(const Symbol *x, const Symbol *y) {
return DesignatorRelation::Disjoint;
}
+static bool IsFullTriplet(const Triplet &triplet) {
+ // Surface syntax `x(:)` maps to a Triplet with no lower or upper bound and
+ // an implicit stride of one.
+ auto stride{ToInt64(triplet.GetStride())};
+ return !triplet.GetLower() && !triplet.GetUpper() && stride && *stride == 1;
+}
+
static bool IsFullSubscriptList(const std::vector<Subscript> &subscripts) {
if (subscripts.empty()) {
return false;
}
for (const Subscript &subscript : subscripts) {
const auto *triplet{std::get_if<Triplet>(&subscript.u)};
- if (!triplet || !DesignatorPath::IsFullTriplet(*triplet)) {
+ if (!triplet || !IsFullTriplet(*triplet)) {
return false;
}
}
@@ -55,8 +77,8 @@ static bool AreAllFullSliceParts(
return true;
}
-std::optional<DesignatorPath::ConstantSubscriptRange>
-DesignatorPath::GetConstantSubscriptRange(const Subscript &subscript) {
+static std::optional<ConstantSubscriptRange> GetConstantSubscriptRange(
+ const Subscript &subscript) {
// Surface syntax `x(i)` maps to a scalar Subscript that holds the integer
// expression `i`, not a Triplet.
if (const auto *expr{
@@ -83,14 +105,56 @@ DesignatorPath::GetConstantSubscriptRange(const Subscript &subscript) {
return std::nullopt;
}
-bool DesignatorPath::IsFullTriplet(const Triplet &triplet) {
- // Surface syntax `x(:)` maps to a Triplet with no lower or upper bound and
- // an implicit stride of one.
- auto stride{ToInt64(triplet.GetStride())};
- return !triplet.GetLower() && !triplet.GetUpper() && stride && *stride == 1;
+// Like GetConstantSubscriptRange, but accepts any nonzero constant stride.
+// Returns nothing for a selection with a nonconstant or missing bound or
+// stride, and for an empty section.
+static std::optional<ConstantSection> GetConstantSection(
+ const Subscript &subscript) {
+ if (const auto *expr{
+ std::get_if<IndirectSubscriptIntegerExpr>(&subscript.u)}) {
+ if (auto value{ToInt64(expr->value())}) {
+ return ConstantSection{*value, *value, 1};
+ }
+ return std::nullopt;
+ }
+ const auto *triplet{std::get_if<Triplet>(&subscript.u)};
+ if (!triplet || !triplet->GetLower() || !triplet->GetUpper()) {
+ return std::nullopt;
+ }
+ auto lower{ToInt64(*triplet->GetLower())};
+ auto upper{ToInt64(*triplet->GetUpper())};
+ auto stride{ToInt64(triplet->GetStride())};
+ if (!lower || !upper || !stride || *stride == 0) {
+ return std::nullopt;
+ }
+ if (*stride > 0) {
+ if (*lower > *upper) {
+ return std::nullopt;
+ }
+ std::int64_t count{(*upper - *lower) / *stride};
+ return ConstantSection{*lower, *lower + count * *stride, *stride};
+ }
+ if (*lower < *upper) {
+ return std::nullopt;
+ }
+ std::int64_t count{(*lower - *upper) / -*stride};
+ return ConstantSection{*lower + count * *stride, *lower, -*stride};
+}
+
+// Every value of y is a value of x. The values of y are an arithmetic
+// progression, so they lie in x exactly when the ends do and, if y has more
+// than one value, the step of y is a multiple of the step of x.
+static bool SectionContains(
+ const ConstantSection &x, const ConstantSection &y) {
+ auto inX{[&](std::int64_t value) {
+ return value >= x.first && value <= x.last &&
+ (value - x.first) % x.stride == 0;
+ }};
+ return inX(y.first) && inX(y.last) &&
+ (y.first == y.last || y.stride % x.stride == 0);
}
-DesignatorRelation DesignatorPath::CompareSubscripts(
+static DesignatorRelation CompareSubscripts(
const Subscript &x, const Subscript &y) {
if (x == y) {
return DesignatorRelation::Equal;
@@ -110,7 +174,8 @@ DesignatorRelation DesignatorPath::CompareSubscripts(
auto yRange{GetConstantSubscriptRange(y)};
if (!xRange || !yRange) {
// Nonconstant selectors and constant triplets with non-unit strides cannot
- // be compared precisely, so treat them as disjoint for now. Constant
+ // be compared precisely, so report them as Disjoint for now. Callers must
+ // not read that as proof that the selections do not overlap. Constant
// triplets could be made more precise by expanding them into index sets.
return DesignatorRelation::Disjoint;
}
@@ -129,8 +194,7 @@ DesignatorRelation DesignatorPath::CompareSubscripts(
return DesignatorRelation::Overlaps;
}
-bool DesignatorPath::SubscriptMayContain(
- const Subscript &x, const Subscript &y) {
+static bool SubscriptMayContain(const Subscript &x, const Subscript &y) {
if (x == y) {
return true;
}
@@ -142,14 +206,16 @@ bool DesignatorPath::SubscriptMayContain(
if (yTriplet && IsFullTriplet(*yTriplet)) {
return false;
}
+ // Decide exactly whenever both selections are constant, including a scalar
+ // against a one-element triplet and any constant stride.
+ auto xSection{GetConstantSection(x)};
+ auto ySection{GetConstantSection(y)};
+ if (xSection && ySection) {
+ return SectionContains(*xSection, *ySection);
+ }
if (!xTriplet && yTriplet) {
return false;
}
- auto xRange{GetConstantSubscriptRange(x)};
- auto yRange{GetConstantSubscriptRange(y)};
- if (xRange && yRange) {
- return xRange->lower <= yRange->lower && xRange->upper >= yRange->upper;
- }
if (xTriplet) {
return true;
}
@@ -157,7 +223,7 @@ bool DesignatorPath::SubscriptMayContain(
!ToInt64(std::get<IndirectSubscriptIntegerExpr>(y.u).value());
}
-bool DesignatorPath::SubscriptListMayContain(
+static bool SubscriptListMayContain(
const std::vector<Subscript> &x, const std::vector<Subscript> &y) {
if (x.empty()) {
return true;
@@ -179,12 +245,13 @@ bool DesignatorPath::SubscriptListMayContain(
return true;
}
-bool DesignatorPath::PartMayContain(const Part &x, const Part &y) {
+static bool PartMayContain(
+ const DesignatorPath::Part &x, const DesignatorPath::Part &y) {
return SubscriptListMayContain(x.subscripts, y.subscripts) &&
(!x.symbol || x.symbol == y.symbol);
}
-DesignatorRelation DesignatorPath::CombineRelations(
+static DesignatorRelation CombineRelations(
bool contains, bool containedBy, bool overlaps) {
if (overlaps || (contains && containedBy)) {
return DesignatorRelation::Overlaps;
@@ -198,7 +265,30 @@ DesignatorRelation DesignatorPath::CombineRelations(
return DesignatorRelation::Equal;
}
-DesignatorRelation DesignatorPath::CompareSubscriptLists(
+// Folds the relation of one subscript or part into the running summary of a
+// comparison. Returns false for Disjoint, which decides the whole comparison.
+static bool Accumulate(DesignatorRelation relation, bool &contains,
+ bool &containedBy, bool &overlaps) {
+ switch (relation) {
+ SWITCH_COVERS_ALL_CASES
+ case DesignatorRelation::Equal:
+ break;
+ case DesignatorRelation::Contains:
+ contains = true;
+ break;
+ case DesignatorRelation::ContainedBy:
+ containedBy = true;
+ break;
+ case DesignatorRelation::Overlaps:
+ overlaps = true;
+ break;
+ case DesignatorRelation::Disjoint:
+ return false;
+ }
+ return true;
+}
+
+static DesignatorRelation CompareSubscriptLists(
const std::vector<Subscript> &x, const std::vector<Subscript> &y) {
if (x.empty() && y.empty()) {
return DesignatorRelation::Equal;
@@ -230,26 +320,16 @@ DesignatorRelation DesignatorPath::CompareSubscriptLists(
bool containedBy{false};
bool overlaps{false};
for (std::size_t i{0}; i < x.size(); ++i) {
- switch (CompareSubscripts(x[i], y[i])) {
- case DesignatorRelation::Equal:
- break;
- case DesignatorRelation::Contains:
- contains = true;
- break;
- case DesignatorRelation::ContainedBy:
- containedBy = true;
- break;
- case DesignatorRelation::Overlaps:
- overlaps = true;
- break;
- case DesignatorRelation::Disjoint:
+ if (!Accumulate(
+ CompareSubscripts(x[i], y[i]), contains, containedBy, overlaps)) {
return DesignatorRelation::Disjoint;
}
}
return CombineRelations(contains, containedBy, overlaps);
}
-DesignatorRelation DesignatorPath::CompareParts(const Part &x, const Part &y) {
+static DesignatorRelation CompareParts(
+ const DesignatorPath::Part &x, const DesignatorPath::Part &y) {
DesignatorRelation subscriptRelation{
CompareSubscriptLists(x.subscripts, y.subscripts)};
if (subscriptRelation == DesignatorRelation::Disjoint) {
@@ -275,7 +355,7 @@ DesignatorRelation DesignatorPath::Compare(const DesignatorPath &that) const {
if (empty() || that.empty()) {
return DesignatorRelation::Disjoint;
}
- if (commonBlock && commonBlock == that.commonBlock) {
+ if (commonBlock_ && commonBlock_ == that.commonBlock_) {
if (IsWholeCommonBlock()) {
return that.IsWholeCommonBlock() ? DesignatorRelation::Equal
: DesignatorRelation::Contains;
@@ -284,47 +364,36 @@ DesignatorRelation DesignatorPath::Compare(const DesignatorPath &that) const {
return DesignatorRelation::ContainedBy;
}
}
- if (base || that.base) {
- if (!base || !that.base || !(*base == *that.base)) {
+ if (base_ || that.base_) {
+ if (!base_ || !that.base_ || !(*base_ == *that.base_)) {
return DesignatorRelation::Disjoint;
}
}
- if (parts.empty() || that.parts.empty()) {
- if ((!parts.empty() && AreAllFullSliceParts(parts, 0)) ||
- (!that.parts.empty() && AreAllFullSliceParts(that.parts, 0))) {
+ if (parts_.empty() || that.parts_.empty()) {
+ if ((!parts_.empty() && AreAllFullSliceParts(parts_, 0)) ||
+ (!that.parts_.empty() && AreAllFullSliceParts(that.parts_, 0))) {
return DesignatorRelation::Equal;
}
- return parts.empty() ? DesignatorRelation::Contains
- : DesignatorRelation::ContainedBy;
+ return parts_.empty() ? DesignatorRelation::Contains
+ : DesignatorRelation::ContainedBy;
}
bool contains{false};
bool containedBy{false};
bool overlaps{false};
const std::size_t commonSize{
- parts.size() < that.parts.size() ? parts.size() : that.parts.size()};
+ parts_.size() < that.parts_.size() ? parts_.size() : that.parts_.size()};
for (std::size_t i{0}; i < commonSize; ++i) {
- switch (CompareParts(parts[i], that.parts[i])) {
- case DesignatorRelation::Equal:
- break;
- case DesignatorRelation::Contains:
- contains = true;
- break;
- case DesignatorRelation::ContainedBy:
- containedBy = true;
- break;
- case DesignatorRelation::Overlaps:
- overlaps = true;
- break;
- case DesignatorRelation::Disjoint:
+ if (!Accumulate(CompareParts(parts_[i], that.parts_[i]), contains,
+ containedBy, overlaps)) {
return DesignatorRelation::Disjoint;
}
}
- if (parts.size() < that.parts.size()) {
- if (!AreAllFullSliceParts(that.parts, parts.size())) {
+ if (parts_.size() < that.parts_.size()) {
+ if (!AreAllFullSliceParts(that.parts_, parts_.size())) {
contains = true;
}
- } else if (that.parts.size() < parts.size()) {
- if (!AreAllFullSliceParts(parts, that.parts.size())) {
+ } else if (that.parts_.size() < parts_.size()) {
+ if (!AreAllFullSliceParts(parts_, that.parts_.size())) {
containedBy = true;
}
}
@@ -335,29 +404,30 @@ bool DesignatorPath::MayContain(const DesignatorPath &that) const {
if (*this == that || empty()) {
return true;
}
- if (commonBlock && commonBlock == that.commonBlock && IsWholeCommonBlock()) {
+ if (commonBlock_ && commonBlock_ == that.commonBlock_ &&
+ IsWholeCommonBlock()) {
return true;
}
- if (base || that.base) {
- if (!base || !that.base || !(*base == *that.base)) {
+ if (base_ || that.base_) {
+ if (!base_ || !that.base_ || !(*base_ == *that.base_)) {
return false;
}
}
- if (that.parts.empty()) {
- return AreAllFullSliceParts(parts, 0);
+ if (that.parts_.empty()) {
+ return AreAllFullSliceParts(parts_, 0);
}
- if (parts.size() > that.parts.size() &&
- !AreAllFullSliceParts(parts, that.parts.size())) {
+ if (parts_.size() > that.parts_.size() &&
+ !AreAllFullSliceParts(parts_, that.parts_.size())) {
return false;
}
- if (parts.empty()) {
+ if (parts_.empty()) {
return true;
}
- for (std::size_t i{0}; i < parts.size(); ++i) {
- if (i >= that.parts.size()) {
- return AreAllFullSliceParts(parts, i);
+ for (std::size_t i{0}; i < parts_.size(); ++i) {
+ if (i >= that.parts_.size()) {
+ return AreAllFullSliceParts(parts_, i);
}
- if (!PartMayContain(parts[i], that.parts[i])) {
+ if (!PartMayContain(parts_[i], that.parts_[i])) {
return false;
}
}
@@ -372,11 +442,11 @@ std::string DesignatorPath::AsFortran() const {
}
llvm::raw_ostream &DesignatorPath::AsFortran(llvm::raw_ostream &o) const {
- if (!base) {
+ if (!base_) {
return o;
}
- base->AsFortran(o);
- for (const Part &part : parts) {
+ base_->AsFortran(o);
+ for (const Part &part : parts_) {
if (!part.subscripts.empty()) {
char separator{'('};
for (const Subscript &subscript : part.subscripts) {
@@ -393,79 +463,34 @@ llvm::raw_ostream &DesignatorPath::AsFortran(llvm::raw_ostream &o) const {
}
bool DesignatorPath::IsWholeCommonBlock() const {
- return commonBlock && HasBaseOnly() && base->IsSymbol() &&
- &base->GetFirstSymbol().GetUltimate() == commonBlock;
+ return commonBlock_ && HasBaseOnly() && base_->IsSymbol() &&
+ &base_->GetFirstSymbol().GetUltimate() == commonBlock_;
}
void DesignatorPath::SetBase(NamedEntity entity) {
- base = std::move(entity);
- commonBlock = nullptr;
- const Symbol &symbol{base->GetFirstSymbol().GetUltimate()};
+ base_ = std::move(entity);
+ commonBlock_ = nullptr;
+ const Symbol &symbol{base_->GetFirstSymbol().GetUltimate()};
if (symbol.has<semantics::CommonBlockDetails>()) {
- commonBlock = &symbol;
+ commonBlock_ = &symbol;
} else if (const auto *details{
symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
if (const Symbol *block{details->commonBlock()}) {
- commonBlock = &block->GetUltimate();
+ commonBlock_ = &block->GetUltimate();
}
}
}
void DesignatorPath::AddComponent(const Symbol &symbol) {
- if (!parts.empty() && !parts.back().symbol) {
- parts.back().symbol = &symbol;
+ if (!parts_.empty() && !parts_.back().symbol) {
+ parts_.back().symbol = &symbol;
} else {
- parts.push_back({{}, &symbol});
+ parts_.push_back({{}, &symbol});
}
}
void DesignatorPath::AddSubscripts(std::vector<Subscript> subscripts) {
- parts.push_back({std::move(subscripts), nullptr});
-}
-
-void DesignatorPath::AddComponent(const Component &component) {
- AddDataRef(component.base());
- AddComponent(*component.symbol());
-}
-
-void DesignatorPath::AddNamedEntity(const NamedEntity &entity) {
- if (const auto *symbol{entity.UnwrapSymbolRef()}) {
- SetBase(NamedEntity{symbol->get()});
- } else if (const auto *component{entity.UnwrapComponent()}) {
- AddComponent(*component);
- }
-}
-
-void DesignatorPath::AddArrayRef(const ArrayRef &arrayRef) {
- AddNamedEntity(arrayRef.base());
- AddSubscripts(arrayRef.subscript());
-}
-
-void DesignatorPath::AddCoarrayRef(const CoarrayRef &coarrayRef) {
- AddDataRef(coarrayRef.base());
-}
-
-void DesignatorPath::AddDataRef(const DataRef &dataRef) {
- common::visit(
- common::visitors{
- [&](SymbolRef symbol) { SetBase(NamedEntity{symbol.get()}); },
- [&](const Component &component) { AddComponent(component); },
- [&](const ArrayRef &arrayRef) { AddArrayRef(arrayRef); },
- [&](const CoarrayRef &coarrayRef) { AddCoarrayRef(coarrayRef); },
- },
- dataRef.u);
-}
-
-std::optional<DesignatorPath> DesignatorPath::Get(
- const std::optional<Expr<SomeType>> &expr) {
- if (std::optional<DataRef> dataRef{ExtractDataRef(expr)}) {
- DesignatorPath path;
- path.AddDataRef(*dataRef);
- if (!path.empty()) {
- return path;
- }
- }
- return std::nullopt;
+ parts_.push_back({std::move(subscripts), nullptr});
}
} // namespace Fortran::evaluate
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 892c5e0ae3bdd9..3cd6d2f3dfdde4 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -27,6 +27,7 @@
#include "flang/Semantics/symbol.h"
#include "flang/Semantics/tools.h"
#include "flang/Support/Flags.h"
+#include "llvm/ADT/STLExtras.h"
#include "llvm/ADT/StringMap.h"
#include "llvm/ADT/StringRef.h"
#include "llvm/Frontend/OpenMP/OMP.h.inc"
@@ -40,7 +41,6 @@
namespace Fortran::semantics {
using evaluate::DesignatorPath;
-using evaluate::DesignatorPathMap;
using evaluate::DesignatorRelation;
using evaluate::NamedEntity;
@@ -174,7 +174,10 @@ template <typename T> class DirectiveAttributeVisitor {
class AccAttributeVisitor {
private:
+ // An object that appears in an OpenACC clause, or is implied by one. The
+ // occurrence is null for an implicit entry, which has no source object.
struct AccDataSharingEntry {
+ DesignatorPath path;
Symbol::Flag flag;
const parser::AccObject *occurrence{nullptr};
};
@@ -187,8 +190,10 @@ class AccAttributeVisitor {
llvm::acc::Directive directive;
Scope &scope;
Symbol::Flag defaultDSA{Symbol::Flag::AccShared};
- DesignatorPathMap<AccDataSharingEntry> clauseObjects;
- DesignatorPathMap<AccDataSharingEntry> objectsWithDSA;
+ // Candidates for conflict analysis.
+ std::vector<AccDataSharingEntry> clauseObjects;
+ // Objects that are visible to body references and DEFAULT(NONE).
+ std::vector<AccDataSharingEntry> objectsWithDSA;
bool clauseObjectsFinalized{false};
bool withinConstruct{false};
std::int64_t associatedLoopLevel{0};
@@ -448,6 +453,8 @@ class AccAttributeVisitor {
Symbol::Flag, DesignatorPath, const parser::AccObject *);
void RecordAccVisibleObject(
Symbol::Flag, DesignatorPath, const parser::AccObject *);
+ void DiagnoseAccDataSharingConflict(parser::CharBlock source,
+ const AccDataSharingEntry &previous, Symbol::Flag, DesignatorRelation);
void CheckImplicitClauseConsistencyInCurrentConstruct(
const parser::Name &, Symbol::Flag, DesignatorPath);
void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList);
@@ -1955,7 +1962,7 @@ DesignatorPath AccAttributeVisitor::MakeBaseDesignatorPath(
bool AccAttributeVisitor::IsObjectWithVisibleDSA(
const DesignatorPath &reference) const {
for (std::size_t i{dirContext_.size()}; i != 0; --i) {
- for (const auto &entry : dirContext_[i - 1].objectsWithDSA) {
+ for (const AccDataSharingEntry &entry : dirContext_[i - 1].objectsWithDSA) {
if (entry.path.MayContain(reference)) {
return true;
}
@@ -1995,6 +2002,15 @@ void AccAttributeVisitor::AdjustAccSymbolReference(const parser::Name &name) {
}
if (Symbol *found{currScope().FindSymbol(name.source)};
found && &symbol != found) {
+ // Don't "adjust" a name that resolution already bound to a construct
+ // entity declared within this region: a DO CONCURRENT or FORALL
+ // index-name (Forall scope) or an entity declared in a nested BLOCK
+ // construct (BlockConstruct scope). currScope() here does not descend
+ // into those construct scopes, so FindSymbol instead resolves to a
+ // like-named variable in an enclosing scope. Rebinding to it would
+ // make the construct entity alias the enclosing variable and, e.g.,
+ // trip the DO-variable redefinition check when that enclosing
+ // variable is an active DO index.
if (DoesScopeContain(&currScope(), symbol)) {
return;
}
@@ -2014,21 +2030,7 @@ void AccAttributeVisitor::CheckAccDefaultNoneReference(
!symbol.has<AssocEntityDetails>() && !symbol.has<MiscDetails>()) {
if (Symbol * found{currScope().FindSymbol(name.source)}) {
if (&symbol != found) {
- // Don't "adjust" a name that resolution already bound to a construct
- // entity declared within this region: a DO CONCURRENT or FORALL
- // index-name (Forall scope) or an entity declared in a nested BLOCK
- // construct (BlockConstruct scope). currScope() here does not descend
- // into those construct scopes, so FindSymbol instead resolves to a
- // like-named variable in an enclosing scope. Rebinding to it would
- // make the construct entity alias the enclosing variable and, e.g.,
- // trip the DO-variable redefinition check when that enclosing
- // variable is an active DO index.
- if (DoesScopeContain(&currScope(), symbol)) {
- return;
- }
- // adjust the symbol within the region
- // TODO: why didn't name resolution set the right name originally?
- name.symbol = found;
+ AdjustAccSymbolReference(name);
} else if (GetContext().defaultDSA == Symbol::Flag::AccNone) {
// 2.5.14. Pre-OpenACC-3.2 behavior: implicit scalars warn instead of
// error unless strict mode is enabled.
@@ -2061,13 +2063,19 @@ bool AccAttributeVisitor::Pre(const parser::Expr &) {
template <typename A>
void AccAttributeVisitor::CheckAccDefaultNoneReferenceIn(const A &x) {
+ // A reference whose structural path cannot be built (a substring, a
+ // coindexed object, an unanalyzable subscript) is still a reference to its
+ // base object, so check that rather than skipping the reference.
if (const auto *designator{
std::get_if<common::Indirection<parser::Designator>>(&x.u)}) {
+ const parser::Name &name{parser::GetFirstName(designator->value())};
std::optional<DesignatorPath> designatorPath{
GetDesignatorPath(context_, designator->value())};
+ if (!designatorPath && name.symbol) {
+ designatorPath = MakeBaseDesignatorPath(*name.symbol);
+ }
if (designatorPath) {
- CheckAccDefaultNoneReference(parser::GetFirstName(designator->value()),
- std::move(*designatorPath));
+ CheckAccDefaultNoneReference(name, std::move(*designatorPath));
}
} else if (const auto *functionReference{
std::get_if<common::Indirection<parser::FunctionReference>>(
@@ -2075,10 +2083,11 @@ void AccAttributeVisitor::CheckAccDefaultNoneReferenceIn(const A &x) {
const parser::Name &name{parser::GetFirstName(functionReference->value())};
if (WithinConstruct() && GetContext().defaultDSA == Symbol::Flag::AccNone &&
name.symbol && name.symbol->has<ObjectEntityDetails>()) {
- if (std::optional<DesignatorPath> designatorPath{
- GetDesignatorPath(context_, functionReference->value())}) {
- CheckAccDefaultNoneReference(name, std::move(*designatorPath));
- }
+ std::optional<DesignatorPath> designatorPath{
+ GetDesignatorPath(context_, functionReference->value())};
+ CheckAccDefaultNoneReference(name,
+ designatorPath ? std::move(*designatorPath)
+ : MakeBaseDesignatorPath(*name.symbol));
}
}
}
@@ -2105,10 +2114,13 @@ bool AccAttributeVisitor::Pre(const parser::ArrayElement &) {
void AccAttributeVisitor::Post(const parser::ArrayElement &arrayElement) {
exitExpressionLikeContext();
- if (std::optional<DesignatorPath> path{
- GetDesignatorPath(context_, arrayElement)}) {
- CheckAccDefaultNoneReference(
- parser::GetFirstName(arrayElement.Base()), std::move(*path));
+ const parser::Name &name{parser::GetFirstName(arrayElement.Base())};
+ std::optional<DesignatorPath> path{GetDesignatorPath(context_, arrayElement)};
+ if (!path && name.symbol) {
+ path = MakeBaseDesignatorPath(*name.symbol);
+ }
+ if (path) {
+ CheckAccDefaultNoneReference(name, std::move(*path));
}
}
@@ -2154,8 +2166,6 @@ void AccAttributeVisitor::ResolveAccObjectList(
}
}
-static bool ContainsStructureComponent(const parser::DataRef &dataRef);
-
static bool ContainsStructureComponent(const parser::DataRef &dataRef) {
return common::visit(
common::visitors{
@@ -2232,9 +2242,10 @@ void AccAttributeVisitor::ResolveAccObject(
common::visit(
common::visitors{
[&](const parser::Designator &designator) {
- // First form an exact structural path. If it cannot be represented,
- // the check below diagnoses resolved unsupported designators;
- // unresolved or otherwise invalid designators are not registered.
+ // Form an exact structural path for a non-bare designator. If it
+ // cannot be represented, diagnose a resolved unsupported
+ // designator; an unresolved or otherwise invalid designator is not
+ // registered.
const bool isBareName{
parser::GetDesignatorNameIfDataRef(designator) != nullptr};
DesignatorPath designatorPath;
@@ -2249,10 +2260,10 @@ void AccAttributeVisitor::ResolveAccObject(
return;
}
}
- // Then resolve the base entity so ACC_DECLARE flags are applied.
if (ContainsStructureComponent(designator)) {
- // Finally register or compare only the complete component path;
- // a component clause does not cover every reference to its base.
+ // Register only the complete component path and do not mark the
+ // base entity: a component clause does not cover every reference
+ // to its base, and ACC_DECLARE flags apply to whole entities.
if (canCheckMultipleAppearances) {
const parser::Name &baseName{parser::GetFirstName(designator)};
if (baseName.symbol && !designatorPath.empty()) {
@@ -2334,33 +2345,34 @@ Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
}
// DesignatorPath::Compare describes the relation between the selected parts of
-// objects, not whether OpenACC permits them in data-sharing clauses. For example,
-// a(1:5) and a(6:10) are Disjoint, but both select parts of the same data-sharing
-// entity and must still be checked for the multiple-appearance restriction.
-// Ignore array selectors here while retaining the base and component symbols:
-// sections of a%x identify the same entity, whereas a%x and a%y do not.
-// Keep this OpenACC policy separate from Compare. Making Compare report overlap
-// for disjoint sections would lose its structural meaning for other callers and
-// would conflate overlap diagnostics with the different-part diagnostic here.
-// Finalization also needs the actual equality and containment relations to prune
-// redundant same-kind objects before checking the surviving objects for conflicts.
+// objects, not whether OpenACC permits them in data-sharing clauses. For
+// example, a(1:5) and a(6:10) are Disjoint, but both select parts of the same
+// data-sharing entity and must still be checked for the multiple-appearance
+// restriction. Ignore array selectors here while retaining the base and
+// component symbols: sections of a%x identify the same entity, whereas a%x and
+// a%y do not. Keep this OpenACC policy separate from Compare. Making Compare
+// report overlap for disjoint sections would lose its structural meaning for
+// other callers and would conflate overlap diagnostics with the different-part
+// diagnostic here. Finalization also needs the actual equality and containment
+// relations to prune redundant same-kind objects before checking the surviving
+// objects for conflicts.
static bool HaveSameAccDataSharingEntity(
const DesignatorPath &x, const DesignatorPath &y) {
- if (x.Base().has_value() != y.Base().has_value() ||
- (x.Base() && !(*x.Base() == *y.Base()))) {
+ if (x.base().has_value() != y.base().has_value() ||
+ (x.base() && !(*x.base() == *y.base()))) {
return false;
}
- auto xIter{x.Parts().begin()};
- auto yIter{y.Parts().begin()};
+ auto xIter{x.parts().begin()};
+ auto yIter{y.parts().begin()};
while (true) {
- while (xIter != x.Parts().end() && !xIter->symbol) {
+ while (xIter != x.parts().end() && !xIter->symbol) {
++xIter;
}
- while (yIter != y.Parts().end() && !yIter->symbol) {
+ while (yIter != y.parts().end() && !yIter->symbol) {
++yIter;
}
- if (xIter == x.Parts().end() || yIter == y.Parts().end()) {
- return xIter == x.Parts().end() && yIter == y.Parts().end();
+ if (xIter == x.parts().end() || yIter == y.parts().end()) {
+ return xIter == x.parts().end() && yIter == y.parts().end();
}
if (xIter->symbol != yIter->symbol) {
return false;
@@ -2379,7 +2391,7 @@ void AccAttributeVisitor::RecordAccVisibleObject(Symbol::Flag accFlag,
return;
}
GetContext().objectsWithDSA.push_back(
- std::move(designator), {accFlag, occurrence});
+ AccDataSharingEntry{std::move(designator), accFlag, occurrence});
}
// Collect candidates without comparing them yet: a later containing object can
@@ -2389,14 +2401,50 @@ void AccAttributeVisitor::RecordAccClauseObject(Symbol::Flag accFlag,
if (designator.empty()) {
return;
}
- GetContext().clauseObjects.push_back(designator, {accFlag, occurrence});
+ GetContext().clauseObjects.push_back(
+ AccDataSharingEntry{designator, accFlag, occurrence});
RecordAccVisibleObject(accFlag, std::move(designator), occurrence);
}
+// Diagnose an object that conflicts with an earlier object of the same
+// directive. Objects of the same kind that are equal, or contained in one
+// another, are not conflicts and are not reported here.
+void AccAttributeVisitor::DiagnoseAccDataSharingConflict(
+ parser::CharBlock source, const AccDataSharingEntry &previous,
+ Symbol::Flag flag, DesignatorRelation relation) {
+ auto emitError{[&](const parser::MessageFixedText &text) {
+ auto &message{context_.Say(source, text, source.ToString())};
+ if (previous.occurrence) {
+ message.Attach(parser::FindSourceLocation(*previous.occurrence),
+ "previous data-sharing object appears here"_en_US);
+ }
+ }};
+ if (previous.flag != flag || flag == Symbol::Flag::AccReduction) {
+ emitError(
+ "'%s' appears in more than one data-sharing clause on the same OpenACC directive"_err_en_US);
+ } else if (relation == DesignatorRelation::Overlaps) {
+ emitError(
+ "'%s' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive"_err_en_US);
+ } else if (relation == DesignatorRelation::Disjoint) {
+ // Disjoint also stands for parts that cannot be compared, so do not claim
+ // that the two parts are separate. Lowering binds the region to a single
+ // operand per object, so it cannot yet represent more than one part.
+ emitError(
+ "multiple parts of the same object in the same kind of data-sharing clause on an OpenACC directive, as in '%s'"_todo_en_US);
+ }
+}
+
// Analyze the complete header in two phases: prune redundant same-kind objects,
// then diagnose conflicts among survivors. Mark removed source occurrences so
// lowering also ignores them. The guard permits both header completion and
// context teardown to call this without repeating diagnostics.
+//
+// Both phases compare every pair of clause objects, and a comparison can
+// compare whole subscript expressions, so the cost is quadratic in the number
+// of objects on one directive. That is negligible for ordinary clause lists,
+// but a list of thousands of objects (for example private(...) naming several
+// thousand scalars) is noticeably slow. Comparing only objects that share a
+// base symbol or COMMON block would remove most of that cost.
void AccAttributeVisitor::FinalizeAccClauseObjects() {
AccDirContext &context{GetContext()};
if (context.clauseObjectsFinalized) {
@@ -2404,31 +2452,30 @@ void AccAttributeVisitor::FinalizeAccClauseObjects() {
}
context.clauseObjectsFinalized = true;
- auto &clauseObjects{context.clauseObjects};
- const std::size_t count{static_cast<std::size_t>(
- std::distance(clauseObjects.begin(), clauseObjects.end()))};
+ std::vector<AccDataSharingEntry> &clauseObjects{context.clauseObjects};
+ const std::size_t count{clauseObjects.size()};
std::vector<std::optional<DesignatorRelation>> redundant(count);
// First find objects made redundant by an equal or containing object with
// the same data-sharing attribute. This pass sees the complete directive,
// so a later whole-object occurrence can subsume earlier unknown sections
// before those sections are compared with one another.
+ //
+ // A contained object is dropped from lowering together with its own operand.
+ // For a POINTER member of a COMMON block listed beside the whole block, that
+ // means the member is copied with the block's bytes, as a copy of the pointer
+ // association, instead of through a separate operand for the pointer.
for (std::size_t i{0}; i < count; ++i) {
- const auto &entry{*(clauseObjects.begin() + i)};
- if (!entry.value.occurrence ||
- !dataSharingAttributeFlags.test(entry.value.flag) ||
- entry.value.flag == Symbol::Flag::AccReduction) {
+ const AccDataSharingEntry &entry{clauseObjects[i]};
+ if (!entry.occurrence || !dataSharingAttributeFlags.test(entry.flag) ||
+ entry.flag == Symbol::Flag::AccReduction) {
continue;
}
for (std::size_t j{0}; j < count; ++j) {
- if (i == j) {
- continue;
- }
- const auto &other{*(clauseObjects.begin() + j)};
- if (entry.value.flag != other.value.flag) {
+ if (i == j || entry.flag != clauseObjects[j].flag) {
continue;
}
- DesignatorRelation relation{entry.path.Compare(other.path)};
+ DesignatorRelation relation{entry.path.Compare(clauseObjects[j].path)};
if (relation == DesignatorRelation::ContainedBy) {
redundant[i] = relation;
break;
@@ -2439,54 +2486,41 @@ void AccAttributeVisitor::FinalizeAccClauseObjects() {
}
}
+ std::vector<AccDataSharingEntry> survivors;
for (std::size_t i{0}; i < count; ++i) {
if (!redundant[i]) {
+ survivors.push_back(std::move(clauseObjects[i]));
continue;
}
- const AccDataSharingEntry &entry{(clauseObjects.begin() + i)->value};
- if (entry.occurrence) {
- const parser::CharBlock source{
- parser::FindSourceLocation(*entry.occurrence)};
- if (*redundant[i] == DesignatorRelation::Equal) {
- context_.Warn(common::UsageWarning::OpenAccUsage, source,
- "'%s' appears more than once in the same kind of data-sharing clause on an OpenACC directive; duplicate ignored"_warn_en_US,
- source.ToString());
- } else {
- context_.Warn(common::UsageWarning::OpenAccUsage, source,
- "'%s' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored"_warn_en_US,
- source.ToString());
- }
- context_.MarkAccObjectDuplicate(entry.occurrence);
- }
- }
-
- for (std::size_t i{count}; i-- > 0;) {
- if (redundant[i]) {
- clauseObjects.erase(clauseObjects.begin() + i);
- }
- }
- for (auto iter{context.objectsWithDSA.begin()};
- iter != context.objectsWithDSA.end();) {
- if (iter->value.occurrence &&
- context_.IsAccObjectDuplicate(iter->value.occurrence)) {
- iter = context.objectsWithDSA.erase(iter);
+ const AccDataSharingEntry &entry{clauseObjects[i]};
+ const parser::CharBlock source{
+ parser::FindSourceLocation(DEREF(entry.occurrence))};
+ if (*redundant[i] == DesignatorRelation::Equal) {
+ context_.Warn(common::UsageWarning::OpenAccUsage, source,
+ "'%s' appears more than once in the same kind of data-sharing clause on an OpenACC directive; duplicate ignored"_warn_en_US,
+ source.ToString());
} else {
- ++iter;
+ context_.Warn(common::UsageWarning::OpenAccUsage, source,
+ "'%s' is contained in another object in the same kind of data-sharing clause on an OpenACC directive; contained object ignored"_warn_en_US,
+ source.ToString());
}
+ context_.MarkAccObjectDuplicate(entry.occurrence);
}
+ clauseObjects = std::move(survivors);
+ llvm::erase_if(context.objectsWithDSA, [&](const AccDataSharingEntry &entry) {
+ return entry.occurrence && context_.IsAccObjectDuplicate(entry.occurrence);
+ });
// Diagnose only the maximal surviving paths. Any pair that was rendered
// harmless by a containing occurrence has already been removed above.
- const std::size_t survivorCount{static_cast<std::size_t>(
- std::distance(clauseObjects.begin(), clauseObjects.end()))};
- for (std::size_t i{0}; i < survivorCount; ++i) {
- const auto &entry{*(clauseObjects.begin() + i)};
- if (!dataSharingAttributeFlags.test(entry.value.flag)) {
+ for (std::size_t i{0}; i < clauseObjects.size(); ++i) {
+ const AccDataSharingEntry &entry{clauseObjects[i]};
+ if (!dataSharingAttributeFlags.test(entry.flag)) {
continue;
}
for (std::size_t j{0}; j < i; ++j) {
- const auto &previous{*(clauseObjects.begin() + j)};
- if (!dataSharingAttributeFlags.test(previous.value.flag)) {
+ const AccDataSharingEntry &previous{clauseObjects[j]};
+ if (!dataSharingAttributeFlags.test(previous.flag)) {
continue;
}
DesignatorRelation relation{previous.path.Compare(entry.path)};
@@ -2498,72 +2532,38 @@ void AccAttributeVisitor::FinalizeAccClauseObjects() {
// TODO: Record the reduction operator in AccDataSharingEntry so
// compatible reductions can use ordinary same-kind duplicate handling.
// Also handle private/reduction interactions on loop constructs.
- const parser::CharBlock source{
- parser::FindSourceLocation(DEREF(entry.value.occurrence))};
- auto emitError{[&](const parser::MessageFixedText &text) {
- auto &message{context_.Say(source, text, source.ToString())};
- if (previous.value.occurrence) {
- message.Attach(parser::FindSourceLocation(*previous.value.occurrence),
- "previous data-sharing object appears here"_en_US);
- }
- }};
- if (previous.value.flag != entry.value.flag ||
- entry.value.flag == Symbol::Flag::AccReduction) {
- emitError(
- "'%s' appears in more than one data-sharing clause on the same OpenACC directive"_err_en_US);
- } else if (relation == DesignatorRelation::Overlaps) {
- emitError(
- "'%s' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive"_err_en_US);
- } else if (relation == DesignatorRelation::Disjoint) {
- emitError(
- "'%s' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive"_err_en_US);
- } else {
- llvm_unreachable("equal and contained same-kind objects were removed");
- }
+ DiagnoseAccDataSharingConflict(
+ parser::FindSourceLocation(DEREF(entry.occurrence)), previous,
+ entry.flag, relation);
break;
}
}
}
-// Check implicit attributes against finalized clauses. New implicit entries have
-// no source occurrence: they participate in consistency and visibility checks,
-// but cannot be marked as removable clause objects.
+// Check implicit attributes against finalized clauses. New implicit entries
+// have no source occurrence: they participate in consistency and visibility
+// checks, but cannot be marked as removable clause objects.
void AccAttributeVisitor::CheckImplicitClauseConsistencyInCurrentConstruct(
const parser::Name &name, Symbol::Flag accFlag, DesignatorPath designator) {
if (designator.empty()) {
return;
}
CHECK(GetContext().clauseObjectsFinalized);
- for (const auto &entry : GetContext().clauseObjects) {
+ for (const AccDataSharingEntry &entry : GetContext().clauseObjects) {
DesignatorRelation relation{entry.path.Compare(designator)};
if (relation == DesignatorRelation::Disjoint &&
!HaveSameAccDataSharingEntity(entry.path, designator)) {
continue;
}
- if (!(dataSharingAttributeFlags.test(entry.value.flag) &&
+ if (!(dataSharingAttributeFlags.test(entry.flag) &&
dataSharingAttributeFlags.test(accFlag))) {
continue;
}
- auto emitError{[&](const parser::MessageFixedText &text) {
- auto &message{context_.Say(name.source, text, name.ToString())};
- if (entry.value.occurrence) {
- message.Attach(parser::FindSourceLocation(*entry.value.occurrence),
- "previous data-sharing object appears here"_en_US);
- }
- }};
- if (entry.value.flag != accFlag || accFlag == Symbol::Flag::AccReduction) {
- emitError(
- "'%s' appears in more than one data-sharing clause on the same OpenACC directive"_err_en_US);
- } else if (relation == DesignatorRelation::Overlaps) {
- emitError(
- "'%s' overlaps another object in the same kind of data-sharing clause on the same OpenACC directive"_err_en_US);
- } else if (relation == DesignatorRelation::Disjoint) {
- emitError(
- "'%s' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive"_err_en_US);
- }
+ DiagnoseAccDataSharingConflict(name.source, entry, accFlag, relation);
return;
}
- GetContext().clauseObjects.push_back(designator, {accFlag, nullptr});
+ GetContext().clauseObjects.push_back(
+ AccDataSharingEntry{designator, accFlag, nullptr});
RecordAccVisibleObject(accFlag, std::move(designator), nullptr);
}
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index ae0eb95ce4e2b7..029eea84fed780 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -40,8 +40,10 @@ namespace Fortran::semantics {
template <typename A>
static std::optional<evaluate::Expr<evaluate::SubscriptInteger>>
AnalyzeSubscriptExpr(SemanticsContext &context, const A &expr) {
- if (auto maybe{evaluate::Fold(
- context.foldingContext(), AnalyzeExpr(context, expr))}) {
+ // The analyzer returns an expression that it has already folded with the
+ // source location of the subscript. Folding it again here would repeat any
+ // folding diagnostic without a location.
+ if (auto maybe{AnalyzeExpr(context, expr)}) {
if (auto *intExpr{
evaluate::UnwrapExpr<evaluate::Expr<evaluate::SomeInteger>>(
maybe)}) {
@@ -103,6 +105,10 @@ static std::optional<std::vector<evaluate::Subscript>> AnalyzeSectionSubscripts(
return subscripts;
}
+static bool AddDesignatorPath(SemanticsContext &context,
+ const parser::StructureComponent &component,
+ evaluate::DesignatorPath &path);
+
static bool AddDesignatorPath(SemanticsContext &context,
const parser::DataRef &dataRef, evaluate::DesignatorPath &path) {
return common::visit(
@@ -116,15 +122,7 @@ static bool AddDesignatorPath(SemanticsContext &context,
},
[&](const common::Indirection<parser::StructureComponent>
&component) {
- if (!AddDesignatorPath(context, component.value().Base(), path)) {
- return false;
- }
- if (const parser::Name &name{component.value().Component()};
- name.symbol) {
- path.AddComponent(name.symbol->GetUltimate());
- return true;
- }
- return false;
+ return AddDesignatorPath(context, component.value(), path);
},
[&](const common::Indirection<parser::ArrayElement> &arrayElement) {
if (!AddDesignatorPath(
@@ -147,6 +145,19 @@ static bool AddDesignatorPath(SemanticsContext &context,
dataRef.u);
}
+static bool AddDesignatorPath(SemanticsContext &context,
+ const parser::StructureComponent &component,
+ evaluate::DesignatorPath &path) {
+ if (!AddDesignatorPath(context, component.Base(), path)) {
+ return false;
+ }
+ if (const parser::Name &name{component.Component()}; name.symbol) {
+ path.AddComponent(name.symbol->GetUltimate());
+ return true;
+ }
+ return false;
+}
+
std::optional<evaluate::DesignatorPath> GetDesignatorPath(
SemanticsContext &context, const parser::Designator &designator) {
evaluate::DesignatorPath path;
@@ -168,8 +179,25 @@ std::optional<evaluate::DesignatorPath> GetDesignatorPath(
const auto &call{funcRef.v};
const auto &procedureDesignator{
std::get<parser::ProcedureDesignator>(call.t)};
- const auto *name{std::get_if<parser::Name>(&procedureDesignator.u)};
- if (!name || !name->symbol || !name->symbol->has<ObjectEntityDetails>()) {
+ evaluate::DesignatorPath path;
+ // Name resolution has not yet rewritten `a(i)` or `x%b(i)` into an array
+ // element, so the base of the subscripts is a bare name or a component.
+ if (const auto *name{std::get_if<parser::Name>(&procedureDesignator.u)}) {
+ if (!name->symbol || !name->symbol->has<ObjectEntityDetails>()) {
+ return std::nullopt;
+ }
+ path.SetBase(evaluate::NamedEntity{name->symbol->GetUltimate()});
+ } else if (const auto *procComponent{std::get_if<parser::ProcComponentRef>(
+ &procedureDesignator.u)}) {
+ // A procedure pointer or type-bound procedure is a call, not a subscripted
+ // array component.
+ const parser::StructureComponent &component{procComponent->v.thing};
+ const Symbol *symbol{component.Component().symbol};
+ if (!symbol || !symbol->GetUltimate().has<ObjectEntityDetails>() ||
+ !AddDesignatorPath(context, component, path)) {
+ return std::nullopt;
+ }
+ } else {
return std::nullopt;
}
std::vector<evaluate::Subscript> subscripts;
@@ -192,8 +220,6 @@ std::optional<evaluate::DesignatorPath> GetDesignatorPath(
if (subscripts.empty()) {
return std::nullopt;
}
- evaluate::DesignatorPath path;
- path.SetBase(evaluate::NamedEntity{name->symbol->GetUltimate()});
path.AddSubscripts(std::move(subscripts));
return path;
}
diff --git a/flang/test/Lower/OpenACC/acc-common-member-dedup.f90 b/flang/test/Lower/OpenACC/acc-common-member-dedup.f90
index d65df7aec6724d..832e56c2bbb1fb 100644
--- a/flang/test/Lower/OpenACC/acc-common-member-dedup.f90
+++ b/flang/test/Lower/OpenACC/acc-common-member-dedup.f90
@@ -1,4 +1,4 @@
-! RUN: bbc -fopenacc -emit-hlfir %s -o - 2>/dev/null | FileCheck %s
+! RUN: bbc -fopenacc -emit-hlfir %s -o - | FileCheck %s
! Retain the whole COMMON operand and drop redundant explicit members.
diff --git a/flang/test/Lower/OpenACC/acc-common-pointer-member-dedup.f90 b/flang/test/Lower/OpenACC/acc-common-pointer-member-dedup.f90
new file mode 100644
index 00000000000000..5439c4f9e9018f
--- /dev/null
+++ b/flang/test/Lower/OpenACC/acc-common-pointer-member-dedup.f90
@@ -0,0 +1,45 @@
+! RUN: bbc -fopenacc -emit-hlfir %s -o - | FileCheck %s
+
+! A POINTER member of a COMMON block that is listed together with the whole
+! block is contained in the block and is dropped, as for any other member. The
+! member is then firstprivatized with the bytes of the block, which copies the
+! pointer association, instead of through an operand of its own. The region
+! derives the member from the block operand.
+
+subroutine block_then_pointer_member()
+ integer :: k
+ integer, pointer :: p
+ common /blk/ k, p
+ !$acc parallel firstprivate(/blk/) firstprivate(p)
+ k = 1
+ p = 2
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPblock_then_pointer_member
+! CHECK-NOT: acc.firstprivate {{.*}} name("p")
+! CHECK: %[[BLOCK:.*]] = acc.firstprivate varPtr({{.*}}) recipe({{.*}}) name("blk") -> !fir.ref<!fir.array<32xi8>>
+! CHECK-NOT: acc.firstprivate
+! CHECK: acc.parallel firstprivate(%[[BLOCK]] : !fir.ref<!fir.array<32xi8>>) {
+! CHECK: hlfir.declare {{.*}} storage(%[[BLOCK]][0])
+! CHECK: hlfir.declare {{.*}} storage(%[[BLOCK]][8]) {{.*}}fortran_attrs<pointer>
+! CHECK: acc.yield
+
+subroutine pointer_member_then_block()
+ integer :: k
+ integer, pointer :: p
+ common /blk/ k, p
+ !$acc parallel firstprivate(p) firstprivate(/blk/)
+ k = 1
+ p = 2
+ !$acc end parallel
+end subroutine
+
+! CHECK-LABEL: func.func @_QPpointer_member_then_block
+! CHECK-NOT: acc.firstprivate {{.*}} name("p")
+! CHECK: %[[BLOCK:.*]] = acc.firstprivate varPtr({{.*}}) recipe({{.*}}) name("blk") -> !fir.ref<!fir.array<32xi8>>
+! CHECK-NOT: acc.firstprivate
+! CHECK: acc.parallel firstprivate(%[[BLOCK]] : !fir.ref<!fir.array<32xi8>>) {
+! CHECK: hlfir.declare {{.*}} storage(%[[BLOCK]][0])
+! CHECK: hlfir.declare {{.*}} storage(%[[BLOCK]][8]) {{.*}}fortran_attrs<pointer>
+! CHECK: acc.yield
diff --git a/flang/test/Lower/OpenACC/acc-copy-reduction.f90 b/flang/test/Lower/OpenACC/acc-copy-reduction.f90
index 5266adf8fc1eea..0cb9c9b2cfc36a 100644
--- a/flang/test/Lower/OpenACC/acc-copy-reduction.f90
+++ b/flang/test/Lower/OpenACC/acc-copy-reduction.f90
@@ -11,10 +11,10 @@ subroutine copy_then_reduction()
! CHECK: %[[COPY1:.*]] = acc.copyin varPtr({{.*}}) dataClause(acc_copy) name("x") -> !fir.ref<i32>
! CHECK: %[[REDUCTION1:.*]] = acc.reduction varPtr({{.*}}) recipe({{.*}}) name("x") -> !fir.ref<i32>
! CHECK: acc.parallel dataOperands(%[[COPY1]] : !fir.ref<i32>) reduction(%[[REDUCTION1]] : !fir.ref<i32>) {
-! TODO: The region body uses the first mapping for x, making lowering depend on
-! clause order. The reduction mapping should take priority in both cases.
-! CHECK: hlfir.declare %[[COPY1]]
-! CHECK: acc.copyout accPtr(%[[COPY1]] : !fir.ref<i32>)
+! TODO: The region body binds x to the first mapping, so lowering depends on
+! clause order. The reduction mapping should take priority in both cases; check
+! the binding here once that is the case. Only the operands, which do not
+! depend on that choice, are checked for now.
subroutine reduction_then_copy()
integer :: x
diff --git a/flang/test/Lower/OpenACC/acc-dedup-private.f90 b/flang/test/Lower/OpenACC/acc-dedup-private.f90
index c96cfb41cd3c0f..a8436825a3242a 100644
--- a/flang/test/Lower/OpenACC/acc-dedup-private.f90
+++ b/flang/test/Lower/OpenACC/acc-dedup-private.f90
@@ -1,4 +1,4 @@
-! RUN: bbc -fopenacc -emit-hlfir %s -o - 2>/dev/null | FileCheck %s
+! RUN: bbc -fopenacc -emit-hlfir %s -o - | FileCheck %s
! Check that same-kind duplicate variables in OpenACC private/firstprivate
! clauses lower without failure, and that each variable produces exactly one
@@ -20,7 +20,7 @@ subroutine test_private_pair(i)
! CHECK-NOT: acc.private varPtr({{.*}}) recipe(@privatization_ref_i32) name("x") -> !fir.ref<i32>
! -----------------------------------------------------------------------
-! private(x, x, x) -- two duplicates (from the triple-occurrence review note)
+! private(x, x, x) -- two duplicates
subroutine test_private_triple(i)
integer :: x, i
diff --git a/flang/test/Lower/OpenACC/implied-do-index.f90 b/flang/test/Lower/OpenACC/implied-do-index.f90
index 6be90af477e9c8..76001a3bd8afd7 100644
--- a/flang/test/Lower/OpenACC/implied-do-index.f90
+++ b/flang/test/Lower/OpenACC/implied-do-index.f90
@@ -13,8 +13,8 @@ subroutine implied_do_index_host(a, x, n)
! CHECK-LABEL: func.func @_QPimplied_do_index_host
! CHECK: hlfir.elemental
! CHECK: %[[HOST_INDEX:.*]] = fir.convert %{{.*}} : (index) -> i64
-! CHECK-NEXT: %[[HOST_KIND:.*]] = fir.convert %[[HOST_INDEX]] : (i64) -> i32
-! CHECK-NEXT: %[[HOST_SUBSCRIPT:.*]] = fir.convert %[[HOST_KIND]] : (i32) -> i64
+! CHECK: %[[HOST_KIND:.*]] = fir.convert %[[HOST_INDEX]] : (i64) -> i32
+! CHECK: %[[HOST_SUBSCRIPT:.*]] = fir.convert %[[HOST_KIND]] : (i32) -> i64
! CHECK: hlfir.designate {{.*}}%[[HOST_SUBSCRIPT]]
! Preserve the explicit kind of an implied-do index when its resolved symbol,
diff --git a/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90 b/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90
index 14865e7d4e56b3..1400ca2d136d4d 100644
--- a/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90
+++ b/flang/test/Semantics/OpenACC/acc-component-ref-dsa.f90
@@ -1,10 +1,12 @@
! RUN: %python %S/../test_errors.py %s %flang -fopenacc -fno-openacc-default-none-scalars-strict
-! Derived-type component references in OpenACC clauses are accepted. Exact
-! duplicate and conflicting component references in data-sharing clauses are
-! diagnosed, but broader containment is deliberately limited for now:
-! - component clauses satisfy DEFAULT(NONE) only for contained references;
-! - bare whole-object/component conflicts are not diagnosed.
+! Derived-type component references in OpenACC clauses are accepted. Each
+! component reference is tracked as a path, so in data-sharing clauses:
+! - a repeated or contained component in the same kind of clause is warned
+! about and ignored;
+! - a component that equals, contains, or is contained in an object in a clause
+! of a different kind is an error, whereas sibling components do not conflict;
+! - component clauses satisfy DEFAULT(NONE) only for contained references.
module component_ref_types
implicit none
@@ -221,3 +223,15 @@ subroutine test_indexed_component_refs_conflict()
end do
!$acc end parallel loop
end subroutine
+
+subroutine test_indexed_component_parts_not_yet_implemented()
+ use component_ref_types, only: vec_t
+ type(vec_t) :: v
+ integer :: i
+ !ERROR: not yet implemented: multiple parts of the same object in the same kind of data-sharing clause on an OpenACC directive, as in 'v%arr(6:10)'
+ !$acc parallel loop private(v%arr(1:5), v%arr(6:10))
+ do i = 1, 10
+ v%arr(i) = real(i)
+ end do
+ !$acc end parallel loop
+end subroutine
diff --git a/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90 b/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90
index 062b80ce88fb3e..b06316b9295546 100644
--- a/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90
+++ b/flang/test/Semantics/OpenACC/acc-dataclause-dedup.f90
@@ -5,8 +5,11 @@
! resolve-directives warns and rewrite-parse-tree drops the duplicate
! occurrences from the clause object lists. When one same-kind object contains
! another, the contained occurrence is likewise dropped. Cross-kind
-! duplicates (e.g. private(x) firstprivate(x)), partial overlaps, disjoint
-! parts of one array, and reduction duplicates remain hard errors.
+! duplicates (e.g. private(x) firstprivate(x)), partial overlaps, and reduction
+! duplicates remain hard errors. Several parts of one array in the same kind of
+! data-sharing clause are not yet implemented and are rejected with a message
+! that does not claim the parts are separate, because parts whose subscripts
+! cannot be compared are rejected the same way.
program test_dataclause_dedup
implicit none
@@ -89,6 +92,29 @@ program test_dataclause_dedup
x = x + i
end do
+ ! The conflict does not depend on the order of the clauses.
+ !ERROR: 'x' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel reduction(+:x) private(x)
+ x = x + 1
+ !$acc end parallel
+
+ !ERROR: 'x' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc serial reduction(+:x) firstprivate(x)
+ x = x + 1
+ !$acc end serial
+
+ !ERROR: 'x' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop reduction(+:x) private(x)
+ do i = 1, 10
+ x = x + i
+ end do
+
+ !ERROR: 'x' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc serial loop reduction(+:x) firstprivate(x)
+ do i = 1, 10
+ x = x + i
+ end do
+
! Reduction is excluded from the benign case: same-flag duplicates may
! differ in operator, which is a real conflict.
!ERROR: 'x' appears in more than one data-sharing clause on the same OpenACC directive
@@ -112,13 +138,13 @@ program test_dataclause_dedup
type(pt) :: s
! Distinct elements of one array still represent the same data-sharing
- ! entity and cannot be lowered as separate private operands.
- !ERROR: 'arr(2)' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive
+ ! entity and cannot yet be lowered as separate private operands.
+ !ERROR: not yet implemented: multiple parts of the same object in the same kind of data-sharing clause on an OpenACC directive, as in 'arr(2)'
!$acc parallel loop private(arr(1), arr(2))
do i = 1, 10
end do
- !ERROR: 'arr(6:10)' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive
+ !ERROR: not yet implemented: multiple parts of the same object in the same kind of data-sharing clause on an OpenACC directive, as in 'arr(6:10)'
!$acc parallel loop private(arr(1:5), arr(6:10))
do i = 1, 10
end do
@@ -234,7 +260,7 @@ program test_dataclause_dedup
! Variable index/section containment cannot be proven, so separate
! appearances of the same array entity are rejected.
- !ERROR: 'arr(lo:hi)' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive
+ !ERROR: not yet implemented: multiple parts of the same object in the same kind of data-sharing clause on an OpenACC directive, as in 'arr(lo:hi)'
!$acc parallel loop private(arr(idx), arr(lo:hi))
do i = 1, 10
end do
@@ -253,7 +279,7 @@ program test_dataclause_dedup
! Variable section overlap cannot be proven, so separate appearances of
! the same array entity are rejected.
- !ERROR: 'arr(mid:hi)' is a different part of an object that already appears in the same kind of data-sharing clause on the same OpenACC directive
+ !ERROR: not yet implemented: multiple parts of the same object in the same kind of data-sharing clause on an OpenACC directive, as in 'arr(mid:hi)'
!$acc parallel loop private(arr(lo:hi), arr(mid:hi))
do i = 1, 10
end do
@@ -264,6 +290,20 @@ program test_dataclause_dedup
do i = 1, 10
end do
+ ! Sections that cannot be compared exactly are rejected with the same
+ ! wording, even when they certainly overlap. A strided section is such a
+ ! section.
+ !ERROR: not yet implemented: multiple parts of the same object in the same kind of data-sharing clause on an OpenACC directive, as in 'arr(1:5)'
+ !$acc parallel loop private(arr(1:10:2), arr(1:5))
+ do i = 1, 10
+ end do
+
+ ! The same holds for subscripts that are equal but not folded to constants.
+ !ERROR: not yet implemented: multiple parts of the same object in the same kind of data-sharing clause on an OpenACC directive, as in 'arr(idx+1-1)'
+ !$acc parallel loop private(arr(idx), arr(idx+1-1))
+ do i = 1, 10
+ end do
+
!ERROR: 'arr(lo:hi)' appears in more than one data-sharing clause on the same OpenACC directive
!$acc parallel loop firstprivate(arr(mid:hi)) private(arr(lo:hi))
do i = 1, 10
@@ -275,6 +315,18 @@ program test_dataclause_dedup
do i = 1, 10
end do
+ ! A reduction conflicts with a different data-sharing clause for another
+ ! part of the same array, whichever clause comes first.
+ !ERROR: 'arr(6:10)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop private(arr(1:5)) reduction(+:arr(6:10))
+ do i = 1, 10
+ end do
+
+ !ERROR: 'arr(1:5)' appears in more than one data-sharing clause on the same OpenACC directive
+ !$acc parallel loop reduction(+:arr(6:10)) private(arr(1:5))
+ do i = 1, 10
+ end do
+
! Distinct structure components -- not duplicates.
!$acc parallel loop private(s%a, s%b)
do i = 1, 10
diff --git a/flang/test/Semantics/OpenACC/acc-default-none-arrays.f90 b/flang/test/Semantics/OpenACC/acc-default-none-arrays.f90
index df990f4f58f57a..447e93049c86e0 100644
--- a/flang/test/Semantics/OpenACC/acc-default-none-arrays.f90
+++ b/flang/test/Semantics/OpenACC/acc-default-none-arrays.f90
@@ -227,3 +227,56 @@ subroutine test_cross_kind_sections2(n)
end do
!$acc end parallel loop
end subroutine
+
+! 11. Containment of a reference in a listed section is decided exactly when
+! the subscripts are constant. A scalar element and a one-element section
+! select the same element, in either order.
+subroutine test_default_none_element_covers_one_element_section()
+ implicit none
+ real :: a(10)
+ !$acc parallel default(none) copy(a(1))
+ a(1:1) = 1.0
+ !$acc end parallel
+end subroutine
+
+subroutine test_default_none_one_element_section_covers_element()
+ implicit none
+ real :: a(10)
+ !$acc parallel default(none) copy(a(1:1))
+ a(1) = 1.0
+ !$acc end parallel
+end subroutine
+
+subroutine test_default_none_element_rejects_longer_section()
+ implicit none
+ real :: a(10)
+ !$acc parallel default(none) copy(a(1))
+ !ERROR: The DEFAULT(NONE) clause requires that 'a' must be listed in a data-mapping clause
+ a(1:2) = 1.0
+ !$acc end parallel
+end subroutine
+
+! 12. A strided section covers only the elements that it selects.
+subroutine test_default_none_strided_section_covers_selected_elements()
+ implicit none
+ real :: a(10)
+ !$acc parallel default(none) copy(a(1:9:2))
+ a(1) = 1.0
+ a(5) = 1.0
+ a(9) = 1.0
+ a(3:7:2) = 1.0
+ !$acc end parallel
+end subroutine
+
+subroutine test_default_none_strided_section_rejects_unselected_elements()
+ implicit none
+ real :: a(10)
+ !$acc parallel default(none) copy(a(1:5:2))
+ !ERROR: The DEFAULT(NONE) clause requires that 'a' must be listed in a data-mapping clause
+ a(4) = 1.0
+ !ERROR: The DEFAULT(NONE) clause requires that 'a' must be listed in a data-mapping clause
+ a(8) = 1.0
+ !ERROR: The DEFAULT(NONE) clause requires that 'a' must be listed in a data-mapping clause
+ a(1:5) = 1.0
+ !$acc end parallel
+end subroutine
diff --git a/flang/test/Semantics/OpenACC/acc-default-none-component-elements.f90 b/flang/test/Semantics/OpenACC/acc-default-none-component-elements.f90
new file mode 100644
index 00000000000000..2679a094ec068e
--- /dev/null
+++ b/flang/test/Semantics/OpenACC/acc-default-none-component-elements.f90
@@ -0,0 +1,136 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenacc -fno-openacc-default-none-scalars-strict -Wno-openacc-default-none-scalars-strict
+
+! DEFAULT(NONE) must check a reference to a single element of an array
+! component, such as x%b(i). When OpenACC analysis runs, name resolution has
+! not yet rewritten such a reference into an array element: it is still a
+! function reference whose procedure designator is a component. It must
+! nevertheless be checked like the equivalent section x%b(i:i).
+
+module component_element_types
+ implicit none
+ abstract interface
+ real function ifc(i)
+ integer, intent(in) :: i
+ end function
+ end interface
+ type :: t
+ real :: b(10)
+ real :: c(10)
+ real :: s
+ procedure(ifc), pointer, nopass :: proc
+ end type
+end module
+
+subroutine test_unlisted_element_reads(x, i)
+ use component_element_types
+ type(t) :: x
+ integer :: i
+ real :: r(2)
+ !$acc parallel default(none) copyout(r)
+ !ERROR: The DEFAULT(NONE) clause requires that 'x' must be listed in a data-mapping clause
+ r(1) = x%b(1)
+ !ERROR: The DEFAULT(NONE) clause requires that 'x' must be listed in a data-mapping clause
+ r(2) = x%b(i)
+ !$acc end parallel
+end subroutine
+
+subroutine test_unlisted_element_write(x, i)
+ use component_element_types
+ type(t) :: x
+ integer :: i
+ !$acc parallel default(none)
+ !ERROR: The DEFAULT(NONE) clause requires that 'x' must be listed in a data-mapping clause
+ x%b(1) = 1.0
+ !ERROR: The DEFAULT(NONE) clause requires that 'x' must be listed in a data-mapping clause
+ x%b(i) = 1.0
+ !$acc end parallel
+end subroutine
+
+subroutine test_unlisted_element_actual_argument(x)
+ use component_element_types
+ type(t) :: x
+ !$acc parallel default(none)
+ !ERROR: The DEFAULT(NONE) clause requires that 'x' must be listed in a data-mapping clause
+ call use_real(x%b(1))
+ !$acc end parallel
+end subroutine
+
+subroutine test_unlisted_section_is_checked_the_same_way(x)
+ use component_element_types
+ type(t) :: x
+ real :: r(2)
+ !$acc parallel default(none) copyout(r)
+ !ERROR: The DEFAULT(NONE) clause requires that 'x' must be listed in a data-mapping clause
+ r(1:1) = x%b(1:1)
+ !$acc end parallel
+end subroutine
+
+subroutine test_listed_component_covers_its_elements(x, i)
+ use component_element_types
+ type(t) :: x
+ integer :: i
+ real :: r(2)
+ !$acc parallel default(none) copy(x%b) copyout(r)
+ r(1) = x%b(1)
+ r(2) = x%b(i)
+ x%b(2) = 1.0
+ !$acc end parallel
+end subroutine
+
+subroutine test_listed_component_section_covers_contained_element(x)
+ use component_element_types
+ type(t) :: x
+ real :: r
+ !$acc parallel default(none) copy(x%b(1:5)) copyout(r)
+ r = x%b(3)
+ !$acc end parallel
+end subroutine
+
+subroutine test_listed_component_section_rejects_other_element(x)
+ use component_element_types
+ type(t) :: x
+ real :: r
+ !$acc parallel default(none) copy(x%b(1:5)) copyout(r)
+ !ERROR: The DEFAULT(NONE) clause requires that 'x' must be listed in a data-mapping clause
+ r = x%b(7)
+ !$acc end parallel
+end subroutine
+
+subroutine test_listed_component_does_not_cover_sibling_element(x)
+ use component_element_types
+ type(t) :: x
+ real :: r
+ !$acc parallel default(none) copy(x%b) copyout(r)
+ !ERROR: The DEFAULT(NONE) clause requires that 'x' must be listed in a data-mapping clause
+ r = x%c(1)
+ !$acc end parallel
+end subroutine
+
+subroutine test_listed_object_covers_element_and_procedure_pointer(x)
+ use component_element_types
+ type(t) :: x
+ real :: r(2)
+ !$acc parallel default(none) copy(x) copyout(r)
+ r(1) = x%b(1)
+ r(2) = x%proc(1)
+ !$acc end parallel
+end subroutine
+
+subroutine test_elements_of_listed_array_of_objects(y, i)
+ use component_element_types
+ type(t) :: y(3)
+ integer :: i
+ real :: r
+ !$acc parallel default(none) copy(y) copyout(r)
+ r = y(2)%b(i)
+ !$acc end parallel
+end subroutine
+
+subroutine test_without_default_none_elements_are_not_flagged(x)
+ use component_element_types
+ type(t) :: x
+ real :: r
+ !$acc parallel copyout(r)
+ r = x%b(1)
+ !$acc end parallel
+end subroutine
diff --git a/flang/test/Semantics/OpenACC/acc-subscript-folding-warning.f90 b/flang/test/Semantics/OpenACC/acc-subscript-folding-warning.f90
new file mode 100644
index 00000000000000..58f90f0c26dbdf
--- /dev/null
+++ b/flang/test/Semantics/OpenACC/acc-subscript-folding-warning.f90
@@ -0,0 +1,17 @@
+! RUN: %flang_fc1 -fsyntax-only -fopenacc %s 2>&1 | FileCheck %s --implicit-check-not="{{^warning:}}"
+
+! OpenACC analysis builds a path from the subscripts of a reference in a
+! region. It must reuse the expression that the analyzer already folded, so a
+! folding diagnostic is reported once, with its source location, and not
+! repeated without a location (which would be unattributable under -Werror).
+
+subroutine folding_warning_has_location(a)
+ real :: a(10)
+ real :: r
+ !$acc parallel default(none) copy(a) copyout(r)
+ r = a(1 / 0)
+ !$acc end parallel
+end subroutine
+
+! CHECK: acc-subscript-folding-warning.f90:{{[0-9]+}}:7: warning: INTEGER(4) division by zero [-Wfolding-exception]
+! CHECK: acc-subscript-folding-warning.f90:{{[0-9]+}}:9: warning: INTEGER(4) division by zero [-Wfolding-exception]
diff --git a/flang/unittests/Evaluate/designator-path.cpp b/flang/unittests/Evaluate/designator-path.cpp
index 7e9812a7bb8732..f15fabdccbd283 100644
--- a/flang/unittests/Evaluate/designator-path.cpp
+++ b/flang/unittests/Evaluate/designator-path.cpp
@@ -16,6 +16,7 @@
#include "flang/Support/LangOptions.h"
#include "flang/Support/default-kinds.h"
#include "flang/Testing/testing.h"
+#include <initializer_list>
using namespace Fortran::evaluate;
@@ -61,6 +62,17 @@ void CheckRelation(const DesignatorPath &x, const DesignatorPath &y,
TEST(x.Compare(y) == relation);
}
+// Compare the selection of a single subscript with that of another.
+void CheckSubscriptRelation(
+ const Subscript &x, const Subscript &y, DesignatorRelation relation) {
+ CheckRelation(PathWithSubscripts({x}), PathWithSubscripts({y}), relation);
+}
+
+void CheckSubscriptMayContain(
+ const Subscript &x, const Subscript &y, bool expected) {
+ TEST(PathWithSubscripts({x}).MayContain(PathWithSubscripts({y})) == expected);
+}
+
class SymbolFixture {
public:
const semantics::Symbol &MakeSymbol(const char *name) {
@@ -100,103 +112,74 @@ class SymbolFixture {
context_.globalScope().MakeScope(semantics::Scope::Kind::MainProgram)};
};
-void TestGetConstantSubscriptRange() {
- auto scalarRange{DesignatorPath::GetConstantSubscriptRange(Scalar(4))};
- TEST(scalarRange.has_value());
- TEST(scalarRange->lower == 4);
- TEST(scalarRange->upper == 4);
-
- auto sectionRange{DesignatorPath::GetConstantSubscriptRange(Section(2, 7))};
- TEST(sectionRange.has_value());
- TEST(sectionRange->lower == 2);
- TEST(sectionRange->upper == 7);
-
- TEST(!DesignatorPath::GetConstantSubscriptRange(Section(2, 7, 2)));
- TEST(!DesignatorPath::GetConstantSubscriptRange(FullSection()));
-}
-
-void TestFullTripletDetection() {
- TEST(DesignatorPath::IsFullTriplet(TripletSubscript({}, {})));
- TEST(!DesignatorPath::IsFullTriplet(TripletSubscript(1, {})));
- TEST(!DesignatorPath::IsFullTriplet(TripletSubscript({}, 10)));
- TEST(!DesignatorPath::IsFullTriplet(TripletSubscript({}, {}, 2)));
+void TestCompareSubscripts() {
+ CheckSubscriptRelation(Scalar(3), Scalar(3), DesignatorRelation::Equal);
+ CheckSubscriptRelation(Scalar(3), Scalar(4), DesignatorRelation::Disjoint);
+ CheckSubscriptRelation(
+ FullSection(), Scalar(3), DesignatorRelation::Contains);
+ CheckSubscriptRelation(
+ FullSection(), FullSection(), DesignatorRelation::Equal);
+ CheckSubscriptRelation(
+ Scalar(3), FullSection(), DesignatorRelation::ContainedBy);
+ CheckSubscriptRelation(
+ Section(1, 5), Section(6, 10), DesignatorRelation::Disjoint);
+ CheckSubscriptRelation(
+ Section(1, 5), Section(1, 5), DesignatorRelation::Equal);
+ CheckSubscriptRelation(
+ Section(1, 10), Section(3, 5), DesignatorRelation::Contains);
+ CheckSubscriptRelation(
+ Section(3, 5), Section(1, 10), DesignatorRelation::ContainedBy);
+ CheckSubscriptRelation(
+ Section(1, 5), Section(5, 10), DesignatorRelation::Overlaps);
+ // A scalar and a one-element section select the same element.
+ CheckSubscriptRelation(Scalar(3), Section(3, 3), DesignatorRelation::Equal);
+ // Strided sections are not compared precisely and are reported as Disjoint.
+ CheckSubscriptRelation(
+ Section(1, 5, 2), Section(1, 5), DesignatorRelation::Disjoint);
}
-void TestCompareSubscripts() {
- TEST(DesignatorPath::CompareSubscripts(Scalar(3), Scalar(3)) ==
+void TestCompareSubscriptLists() {
+ CheckRelation(PathWithSubscripts({}), PathWithSubscripts({FullSection()}),
DesignatorRelation::Equal);
- TEST(DesignatorPath::CompareSubscripts(FullSection(), Scalar(3)) ==
- DesignatorRelation::Contains);
- TEST(DesignatorPath::CompareSubscripts(FullSection(), FullSection()) ==
+ CheckRelation(PathWithSubscripts({FullSection()}), PathWithSubscripts({}),
DesignatorRelation::Equal);
- TEST(DesignatorPath::CompareSubscripts(Scalar(3), FullSection()) ==
- DesignatorRelation::ContainedBy);
- TEST(DesignatorPath::CompareSubscripts(Section(1, 5), Section(6, 10)) ==
+ CheckRelation(PathWithSubscripts({FullSection()}),
+ PathWithSubscripts({FullSection(), FullSection()}),
DesignatorRelation::Disjoint);
- TEST(DesignatorPath::CompareSubscripts(Section(1, 5), Section(1, 5)) ==
- DesignatorRelation::Equal);
- TEST(DesignatorPath::CompareSubscripts(Section(1, 10), Section(3, 5)) ==
+ CheckRelation(PathWithSubscripts({Scalar(1)}),
+ PathWithSubscripts({Scalar(1), Scalar(2)}), DesignatorRelation::Disjoint);
+ CheckRelation(PathWithSubscripts({Scalar(1), Scalar(2)}),
+ PathWithSubscripts({Scalar(1), Scalar(2)}), DesignatorRelation::Equal);
+ CheckRelation(PathWithSubscripts({Section(1, 10), Scalar(2)}),
+ PathWithSubscripts({Section(3, 5), Scalar(2)}),
DesignatorRelation::Contains);
- TEST(DesignatorPath::CompareSubscripts(Section(3, 5), Section(1, 10)) ==
+ CheckRelation(PathWithSubscripts({Section(3, 5), Scalar(2)}),
+ PathWithSubscripts({Section(1, 10), Scalar(2)}),
DesignatorRelation::ContainedBy);
- TEST(DesignatorPath::CompareSubscripts(Section(1, 5), Section(5, 10)) ==
+ // One dimension contains and the other is contained, so they only overlap.
+ CheckRelation(PathWithSubscripts({Section(1, 10), Scalar(2)}),
+ PathWithSubscripts({Section(3, 5), FullSection()}),
DesignatorRelation::Overlaps);
- TEST(DesignatorPath::CompareSubscripts(Section(1, 5, 2), Section(1, 5)) ==
+ CheckRelation(PathWithSubscripts({Section(1, 5), Scalar(2)}),
+ PathWithSubscripts({Section(6, 10), Scalar(2)}),
DesignatorRelation::Disjoint);
}
-void TestCompareSubscriptLists() {
- TEST(DesignatorPath::CompareSubscriptLists({}, {FullSection()}) ==
- DesignatorRelation::Equal);
- TEST(DesignatorPath::CompareSubscriptLists({FullSection()}, {}) ==
- DesignatorRelation::Equal);
- TEST(DesignatorPath::CompareSubscriptLists({FullSection()},
- {FullSection(), FullSection()}) == DesignatorRelation::Disjoint);
- TEST(DesignatorPath::CompareSubscriptLists({Scalar(1)},
- {Scalar(1), Scalar(2)}) == DesignatorRelation::Disjoint);
- TEST(DesignatorPath::CompareSubscriptLists({Scalar(1), Scalar(2)},
- {Scalar(1), Scalar(2)}) == DesignatorRelation::Equal);
- TEST(DesignatorPath::CompareSubscriptLists({Section(1, 10), Scalar(2)},
- {Section(3, 5), Scalar(2)}) == DesignatorRelation::Contains);
- TEST(DesignatorPath::CompareSubscriptLists({Section(3, 5), Scalar(2)},
- {Section(1, 10), Scalar(2)}) == DesignatorRelation::ContainedBy);
- TEST(DesignatorPath::CompareSubscriptLists({Section(1, 10), Scalar(2)},
- {Section(3, 5), FullSection()}) == DesignatorRelation::Overlaps);
- TEST(DesignatorPath::CompareSubscriptLists({Section(1, 5), Scalar(2)},
- {Section(6, 10), Scalar(2)}) == DesignatorRelation::Disjoint);
-}
-
void TestCompareParts() {
SymbolFixture symbols;
const semantics::Symbol &symbol1{symbols.MakeSymbol("a")};
const semantics::Symbol &symbol2{symbols.MakeSymbol("b")};
- DesignatorPath::Part component1{{}, &symbol1};
- DesignatorPath::Part component1Again{{}, &symbol1};
- DesignatorPath::Part component2{{}, &symbol2};
- DesignatorPath::Part subscripts{{Section(1, 5)}, nullptr};
- DesignatorPath::Part subscriptedComponent{{Scalar(3)}, &symbol1};
-
- TEST(DesignatorPath::CompareParts(component1, component1Again) ==
- DesignatorRelation::Equal);
- TEST(DesignatorPath::CompareParts(component1, component2) ==
- DesignatorRelation::Disjoint);
- TEST(DesignatorPath::CompareParts(component1, subscripts) ==
- DesignatorRelation::Overlaps);
- TEST(DesignatorPath::CompareParts(subscripts, subscriptedComponent) ==
- DesignatorRelation::Contains);
-}
-
-void TestCombineRelations() {
- TEST(DesignatorPath::CombineRelations(false, false, false) ==
- DesignatorRelation::Equal);
- TEST(DesignatorPath::CombineRelations(true, false, false) ==
- DesignatorRelation::Contains);
- TEST(DesignatorPath::CombineRelations(false, true, false) ==
- DesignatorRelation::ContainedBy);
- TEST(DesignatorPath::CombineRelations(false, false, true) ==
- DesignatorRelation::Overlaps);
- TEST(DesignatorPath::CombineRelations(true, true, false) ==
- DesignatorRelation::Overlaps);
+ DesignatorPath component1{PathWithComponent(&symbol1)};
+ DesignatorPath component1Again{PathWithComponent(&symbol1)};
+ DesignatorPath component2{PathWithComponent(&symbol2)};
+ DesignatorPath subscripts{PathWithSubscripts({Section(1, 5)})};
+ DesignatorPath subscriptedComponent{PathWithSubscripts({Scalar(3)})};
+ subscriptedComponent.AddComponent(symbol1);
+
+ CheckRelation(component1, component1Again, DesignatorRelation::Equal);
+ CheckRelation(component1, component2, DesignatorRelation::Disjoint);
+ CheckRelation(component1, subscripts, DesignatorRelation::Overlaps);
+ CheckRelation(subscripts, subscriptedComponent, DesignatorRelation::Contains);
}
void TestComparePaths() {
@@ -205,17 +188,6 @@ void TestComparePaths() {
CheckRelation(
empty, PathWithSubscripts({Scalar(1)}), DesignatorRelation::Disjoint);
- CheckRelation(PathWithSubscripts({Scalar(1)}),
- PathWithSubscripts({Scalar(1)}), DesignatorRelation::Equal);
- CheckRelation(PathWithSubscripts({Section(1, 10)}),
- PathWithSubscripts({Scalar(5)}), DesignatorRelation::Contains);
- CheckRelation(PathWithSubscripts({Scalar(5)}),
- PathWithSubscripts({Section(1, 10)}), DesignatorRelation::ContainedBy);
- CheckRelation(PathWithSubscripts({Section(1, 5)}),
- PathWithSubscripts({Section(5, 10)}), DesignatorRelation::Overlaps);
- CheckRelation(PathWithSubscripts({Section(1, 5)}),
- PathWithSubscripts({Section(6, 10)}), DesignatorRelation::Disjoint);
-
SymbolFixture symbols;
const semantics::Symbol &symbol{symbols.MakeSymbol("c")};
DesignatorPath parent{PathWithComponent(&symbol)};
@@ -226,36 +198,58 @@ void TestComparePaths() {
}
void TestMayContainSubscripts() {
- TEST(DesignatorPath::SubscriptMayContain(Scalar(1), Scalar(1)));
- TEST(DesignatorPath::SubscriptMayContain(FullSection(), Scalar(7)));
- TEST(!DesignatorPath::SubscriptMayContain(Scalar(7), FullSection()));
- TEST(!DesignatorPath::SubscriptMayContain(Section(1, 5), FullSection()));
- TEST(DesignatorPath::SubscriptMayContain(Section(1, 10), Scalar(7)));
- TEST(!DesignatorPath::SubscriptMayContain(Section(1, 5), Scalar(7)));
- TEST(DesignatorPath::SubscriptMayContain(Section(1, 5, 2), Scalar(7)));
- TEST(!DesignatorPath::SubscriptListMayContain(
- {Scalar(1)}, {Scalar(1), Scalar(2)}));
- TEST(DesignatorPath::SubscriptListMayContain({FullSection()}, {}));
- TEST(!DesignatorPath::SubscriptListMayContain(
- {FullSection()}, {Scalar(1), Scalar(2)}));
- TEST(DesignatorPath::SubscriptListMayContain(
- {FullSection(), Section(1, 10)}, {Scalar(2), Scalar(5)}));
+ CheckSubscriptMayContain(Scalar(1), Scalar(1), true);
+ CheckSubscriptMayContain(FullSection(), Scalar(7), true);
+ CheckSubscriptMayContain(Scalar(7), FullSection(), false);
+ CheckSubscriptMayContain(Section(1, 5), FullSection(), false);
+ CheckSubscriptMayContain(Section(1, 10), Scalar(7), true);
+ CheckSubscriptMayContain(Section(1, 5), Scalar(7), false);
+
+ // A scalar covers a one-element section of the same element, and only that.
+ CheckSubscriptMayContain(Scalar(1), Section(1, 1), true);
+ CheckSubscriptMayContain(Section(1, 1), Scalar(1), true);
+ CheckSubscriptMayContain(Scalar(1), Section(1, 2), false);
+ CheckSubscriptMayContain(Scalar(2), Section(1, 1), false);
+
+ // Constant strides decide containment exactly.
+ CheckSubscriptMayContain(Section(1, 5, 2), Scalar(1), true);
+ CheckSubscriptMayContain(Section(1, 5, 2), Scalar(3), true);
+ CheckSubscriptMayContain(Section(1, 5, 2), Scalar(5), true);
+ CheckSubscriptMayContain(Section(1, 5, 2), Scalar(4), false);
+ CheckSubscriptMayContain(Section(1, 5, 2), Scalar(7), false);
+ CheckSubscriptMayContain(Section(1, 9, 2), Section(3, 7, 2), true);
+ CheckSubscriptMayContain(Section(1, 9, 2), Section(3, 7, 4), true);
+ CheckSubscriptMayContain(Section(1, 9, 2), Section(3, 7, 3), false);
+ CheckSubscriptMayContain(Section(1, 9, 4), Section(1, 9, 2), false);
+ CheckSubscriptMayContain(Section(9, 1, -2), Scalar(5), true);
+ CheckSubscriptMayContain(Section(9, 1, -2), Scalar(4), false);
+
+ CheckSubscriptMayContain(Scalar(1), Scalar(2), false);
+
+ TEST(!PathWithSubscripts({Scalar(1)})
+ .MayContain(PathWithSubscripts({Scalar(1), Scalar(2)})));
+ TEST(PathWithSubscripts({FullSection()}).MayContain(PathWithSubscripts({})));
+ TEST(!PathWithSubscripts({FullSection()})
+ .MayContain(PathWithSubscripts({Scalar(1), Scalar(2)})));
+ TEST(PathWithSubscripts({FullSection(), Section(1, 10)})
+ .MayContain(PathWithSubscripts({Scalar(2), Scalar(5)})));
}
void TestMayContainPartsAndPaths() {
SymbolFixture symbols;
const semantics::Symbol &symbol1{symbols.MakeSymbol("d")};
const semantics::Symbol &symbol2{symbols.MakeSymbol("e")};
- DesignatorPath::Part component1{{}, &symbol1};
- DesignatorPath::Part component2{{}, &symbol2};
- DesignatorPath::Part subscripts{{Section(1, 10)}, nullptr};
- DesignatorPath::Part scalarSubscript{{Scalar(5)}, nullptr};
- DesignatorPath::Part scalarComponent{{Scalar(5)}, &symbol1};
-
- TEST(DesignatorPath::PartMayContain(component1, component1));
- TEST(!DesignatorPath::PartMayContain(component1, component2));
- TEST(DesignatorPath::PartMayContain(subscripts, scalarComponent));
- TEST(DesignatorPath::PartMayContain(subscripts, scalarSubscript));
+ DesignatorPath component1{PathWithComponent(&symbol1)};
+ DesignatorPath component2{PathWithComponent(&symbol2)};
+ DesignatorPath subscripts{PathWithSubscripts({Section(1, 10)})};
+ DesignatorPath scalarSubscript{PathWithSubscripts({Scalar(5)})};
+ DesignatorPath scalarComponent{PathWithSubscripts({Scalar(5)})};
+ scalarComponent.AddComponent(symbol1);
+
+ TEST(component1.MayContain(component1));
+ TEST(!component1.MayContain(component2));
+ TEST(subscripts.MayContain(scalarComponent));
+ TEST(subscripts.MayContain(scalarSubscript));
DesignatorPath empty;
DesignatorPath parent{PathWithComponent(&symbol1)};
@@ -271,29 +265,79 @@ void TestMayContainPartsAndPaths() {
TEST(!parent.MayContain(sibling));
}
-void TestAddFunctionsAndMap() {
+// DEFAULT(NONE) relies on MayContain agreeing with Compare, and the conflict
+// analysis relies on Compare being symmetric.
+void TestCompareIsSymmetricAndAgreesWithMayContain() {
+ SymbolFixture symbols;
+ auto &block{symbols.MakeCommonBlock("blk")};
+ const auto &member{symbols.MakeCommonMember("m", block)};
+ const auto &sibling{symbols.MakeCommonMember("n", block)};
+ const auto &component1{symbols.MakeSymbol("p")};
+ const auto &component2{symbols.MakeSymbol("q")};
+
+ std::vector<DesignatorPath> paths;
+ paths.emplace_back();
+ for (const Subscript &subscript :
+ {Scalar(1), Scalar(5), Scalar(7), Section(1, 1), Section(1, 5),
+ Section(1, 10), Section(5, 10), Section(6, 10), FullSection(),
+ Section(1, 5, 2), Section(2, 10, 4), Section(10, 1, -1)}) {
+ paths.push_back(PathWithSubscripts({subscript}));
+ DesignatorPath withComponent{PathWithSubscripts({subscript})};
+ withComponent.AddComponent(component1);
+ paths.push_back(withComponent);
+ }
+ paths.push_back(PathWithComponent(&component1));
+ paths.push_back(PathWithComponent(&component2));
+ for (const semantics::Symbol *base :
+ std::initializer_list<const semantics::Symbol *>{
+ &block, &member, &sibling}) {
+ DesignatorPath path;
+ path.SetBase(NamedEntity{*base});
+ paths.push_back(path);
+ path.AddSubscripts({Section(1, 5)});
+ paths.push_back(path);
+ }
+
+ for (const DesignatorPath &x : paths) {
+ for (const DesignatorPath &y : paths) {
+ DesignatorRelation relation{x.Compare(y)};
+ DesignatorRelation reverse{y.Compare(x)};
+ switch (relation) {
+ case DesignatorRelation::Equal:
+ case DesignatorRelation::Overlaps:
+ case DesignatorRelation::Disjoint:
+ TEST(reverse == relation);
+ break;
+ case DesignatorRelation::Contains:
+ TEST(reverse == DesignatorRelation::ContainedBy);
+ break;
+ case DesignatorRelation::ContainedBy:
+ TEST(reverse == DesignatorRelation::Contains);
+ break;
+ }
+ if (relation == DesignatorRelation::Equal) {
+ TEST(x.MayContain(y));
+ TEST(y.MayContain(x));
+ } else if (relation == DesignatorRelation::Contains) {
+ TEST(x.MayContain(y));
+ }
+ }
+ }
+}
+
+void TestPathConstruction() {
SymbolFixture symbols;
const semantics::Symbol &symbol{symbols.MakeSymbol("f")};
DesignatorPath path;
TEST(path.empty());
path.AddComponent(symbol);
path.AddSubscripts({Scalar(1), Scalar(2)});
- TEST(path.Parts().size() == 2);
- TEST(path.Parts()[0].subscripts.empty());
- TEST(path.Parts()[0].symbol == &symbol);
- TEST(path.Parts()[1].subscripts.size() == 2);
- TEST(path.Parts()[1].symbol == nullptr);
-
- DesignatorPathMap<int> map;
- TEST(map.empty());
- map.push_back(path, 42);
- TEST(!map.empty());
- TEST(map.begin()->value == 42);
- map.erase(map.begin());
- TEST(map.empty());
- map.push_back(DesignatorPath{}, 7);
- map.clear();
- TEST(map.empty());
+ TEST(!path.empty());
+ TEST(path.parts().size() == 2);
+ TEST(path.parts()[0].subscripts.empty());
+ TEST(path.parts()[0].symbol == &symbol);
+ TEST(path.parts()[1].subscripts.size() == 2);
+ TEST(path.parts()[1].symbol == nullptr);
}
void TestSubscriptsPrecedeComponentWithinPart() {
@@ -304,8 +348,9 @@ void TestSubscriptsPrecedeComponentWithinPart() {
DesignatorPath x;
x.SetBase(NamedEntity{base});
- TEST(x.Base().has_value());
- TEST(x.Parts().empty());
+ TEST(x.base().has_value());
+ TEST(x.parts().empty());
+ TEST(x.HasBaseOnly());
DesignatorPath differentBase;
differentBase.SetBase(NamedEntity{y});
@@ -313,18 +358,17 @@ void TestSubscriptsPrecedeComponentWithinPart() {
DesignatorPath xFull;
xFull.SetBase(NamedEntity{base});
xFull.AddSubscripts({FullSection()});
- TEST(xFull.Parts().size() == 1);
- TEST(xFull.Parts()[0].subscripts.size() == 1);
- TEST(xFull.Parts()[0].subscripts[0] == FullSection());
+ TEST(xFull.parts().size() == 1);
+ TEST(xFull.parts()[0].subscripts.size() == 1);
+ TEST(xFull.parts()[0].subscripts[0] == FullSection());
const auto *fullTriplet{
- std::get_if<Triplet>(&xFull.Parts()[0].subscripts[0].u)};
+ std::get_if<Triplet>(&xFull.parts()[0].subscripts[0].u)};
TEST(fullTriplet != nullptr);
if (fullTriplet) {
TEST(!fullTriplet->GetLower());
TEST(!fullTriplet->GetUpper());
- TEST(DesignatorPath::IsFullTriplet(*fullTriplet));
}
- TEST(xFull.Parts()[0].symbol == nullptr);
+ TEST(xFull.parts()[0].symbol == nullptr);
TEST(!(xFull == x));
TEST(x.Compare(xFull) == DesignatorRelation::Equal);
TEST(xFull.Compare(x) == DesignatorRelation::Equal);
@@ -335,27 +379,27 @@ void TestSubscriptsPrecedeComponentWithinPart() {
DesignatorPath xSection;
xSection.SetBase(NamedEntity{base});
xSection.AddSubscripts({Section(1, 10)});
- TEST(xSection.Base().has_value());
- TEST(xSection.Parts().size() == 1);
- TEST(xSection.Parts()[0].subscripts.size() == 1);
- TEST(xSection.Parts()[0].symbol == nullptr);
+ TEST(xSection.base().has_value());
+ TEST(xSection.parts().size() == 1);
+ TEST(xSection.parts()[0].subscripts.size() == 1);
+ TEST(xSection.parts()[0].symbol == nullptr);
DesignatorPath xSectionY;
xSectionY.SetBase(NamedEntity{base});
xSectionY.AddSubscripts({Section(1, 10)});
xSectionY.AddComponent(y);
- TEST(xSectionY.Parts().size() == 1);
- TEST(xSectionY.Parts()[0].subscripts.size() == 1);
- TEST(xSectionY.Parts()[0].symbol == &y);
+ TEST(xSectionY.parts().size() == 1);
+ TEST(xSectionY.parts()[0].subscripts.size() == 1);
+ TEST(xSectionY.parts()[0].symbol == &y);
DesignatorPath xSectionYFull{xSectionY};
xSectionYFull.AddSubscripts({FullSection()});
- TEST(xSectionYFull.Parts().size() == 2);
- TEST(xSectionYFull.Parts()[0].subscripts.size() == 1);
- TEST(xSectionYFull.Parts()[0].symbol == &y);
- TEST(xSectionYFull.Parts()[1].subscripts.size() == 1);
- TEST(xSectionYFull.Parts()[1].subscripts[0] == FullSection());
- TEST(xSectionYFull.Parts()[1].symbol == nullptr);
+ TEST(xSectionYFull.parts().size() == 2);
+ TEST(xSectionYFull.parts()[0].subscripts.size() == 1);
+ TEST(xSectionYFull.parts()[0].symbol == &y);
+ TEST(xSectionYFull.parts()[1].subscripts.size() == 1);
+ TEST(xSectionYFull.parts()[1].subscripts[0] == FullSection());
+ TEST(xSectionYFull.parts()[1].symbol == nullptr);
TEST(!(xSectionYFull == xSectionY));
TEST(xSectionYFull.Compare(xSectionY) == DesignatorRelation::Equal);
TEST(xSectionY.Compare(xSectionYFull) == DesignatorRelation::Equal);
@@ -368,12 +412,12 @@ void TestSubscriptsPrecedeComponentWithinPart() {
xSectionYFullZ.AddComponent(y);
xSectionYFullZ.AddSubscripts({FullSection()});
xSectionYFullZ.AddComponent(z);
- TEST(xSectionYFullZ.Parts().size() == 2);
- TEST(xSectionYFullZ.Parts()[0].subscripts.size() == 1);
- TEST(xSectionYFullZ.Parts()[0].symbol == &y);
- TEST(xSectionYFullZ.Parts()[1].subscripts.size() == 1);
- TEST(xSectionYFullZ.Parts()[1].subscripts[0] == FullSection());
- TEST(xSectionYFullZ.Parts()[1].symbol == &z);
+ TEST(xSectionYFullZ.parts().size() == 2);
+ TEST(xSectionYFullZ.parts()[0].subscripts.size() == 1);
+ TEST(xSectionYFullZ.parts()[0].symbol == &y);
+ TEST(xSectionYFullZ.parts()[1].subscripts.size() == 1);
+ TEST(xSectionYFullZ.parts()[1].subscripts[0] == FullSection());
+ TEST(xSectionYFullZ.parts()[1].symbol == &z);
}
void TestAsFortran() {
@@ -411,10 +455,10 @@ void TestCommonBlockPaths() {
other.SetBase(NamedEntity{c});
outside.SetBase(NamedEntity{unrelated});
hostAssociated.SetBase(NamedEntity{alias});
- TEST(wholeBlock.CommonBlock() == &block);
- TEST(member.CommonBlock() == &block);
- TEST(hostAssociated.CommonBlock() == &block);
- TEST(!outside.CommonBlock());
+ TEST(wholeBlock.commonBlock() == &block);
+ TEST(member.commonBlock() == &block);
+ TEST(hostAssociated.commonBlock() == &block);
+ TEST(!outside.commonBlock());
CheckRelation(wholeBlock, member, DesignatorRelation::Contains);
CheckRelation(member, wholeBlock, DesignatorRelation::ContainedBy);
@@ -436,28 +480,26 @@ void TestCommonBlockPaths() {
CheckRelation(wholeBlock, subobject, DesignatorRelation::Contains);
TEST(wholeBlock.MayContain(section));
TEST(wholeBlock.MayContain(subobject));
- TEST(section.CommonBlock() == &block);
+ TEST(section.commonBlock() == &block);
auto copied{wholeBlock};
TEST(copied == wholeBlock);
copied.SetBase(NamedEntity{unrelated});
- TEST(!copied.CommonBlock());
+ TEST(!copied.commonBlock());
CheckRelation(copied, member, DesignatorRelation::Disjoint);
}
} // namespace
int main() {
- TestGetConstantSubscriptRange();
- TestFullTripletDetection();
TestCompareSubscripts();
TestCompareSubscriptLists();
TestCompareParts();
- TestCombineRelations();
TestComparePaths();
TestMayContainSubscripts();
TestMayContainPartsAndPaths();
- TestAddFunctionsAndMap();
+ TestCompareIsSymmetricAndAgreesWithMayContain();
+ TestPathConstruction();
TestSubscriptsPrecedeComponentWithinPart();
TestAsFortran();
TestCommonBlockPaths();
More information about the flang-commits
mailing list