diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -1054,6 +1054,8 @@ bool IsAutomatic(const Symbol &); bool IsSaved(const Symbol &); // saved implicitly or explicitly bool IsDummy(const Symbol &); +bool IsAssumedShape(const Symbol &); +bool IsDeferredShape(const Symbol &); bool IsFunctionResult(const Symbol &); bool IsKindTypeParameter(const Symbol &); bool IsLenTypeParameter(const Symbol &); diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -188,11 +188,11 @@ } bool IsArray() const { return !shape_.empty(); } bool IsCoarray() const { return !coshape_.empty(); } - bool IsAssumedShape() const { return isDummy() && shape_.IsAssumedShape(); } - bool IsDeferredShape() const { - return !isDummy() && shape_.IsDeferredShape(); + bool CanBeAssumedShape() const { + return isDummy() && shape_.CanBeAssumedShape(); } - bool IsAssumedSize() const { return isDummy() && shape_.IsAssumedSize(); } + bool CanBeDeferredShape() const { return shape_.CanBeDeferredShape(); } + bool IsAssumedSize() const { return isDummy() && shape_.CanBeAssumedSize(); } bool IsAssumedRank() const { return isDummy() && shape_.IsAssumedRank(); } private: diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h --- a/flang/include/flang/Semantics/type.h +++ b/flang/include/flang/Semantics/type.h @@ -47,11 +47,17 @@ using MaybeSubscriptIntExpr = std::optional; using KindExpr = SubscriptIntExpr; -// An array spec bound: an explicit integer expression or ASSUMED or DEFERRED +// An array spec bound: an explicit integer expression, assumed size +// or implied shape(*), or assumed or deferred shape(:). In the absence +// of explicit lower bounds it is not possible to distinguish assumed +// shape bounds from deferred shape bounds without knowing whether the +// particular symbol is an allocatable/pointer or a non-allocatable +// non-pointer dummy; use the symbol-based predicates for those +// determinations. class Bound { public: - static Bound Assumed() { return Bound(Category::Assumed); } - static Bound Deferred() { return Bound(Category::Deferred); } + static Bound Star() { return Bound(Category::Star); } + static Bound Colon() { return Bound(Category::Colon); } explicit Bound(MaybeSubscriptIntExpr &&expr) : expr_{std::move(expr)} {} explicit Bound(common::ConstantSubscript bound); Bound(const Bound &) = default; @@ -59,8 +65,8 @@ Bound &operator=(const Bound &) = default; Bound &operator=(Bound &&) = default; bool isExplicit() const { return category_ == Category::Explicit; } - bool isAssumed() const { return category_ == Category::Assumed; } - bool isDeferred() const { return category_ == Category::Deferred; } + bool isStar() const { return category_ == Category::Star; } + bool isColon() const { return category_ == Category::Colon; } MaybeSubscriptIntExpr &GetExplicit() { return expr_; } const MaybeSubscriptIntExpr &GetExplicit() const { return expr_; } void SetExplicit(MaybeSubscriptIntExpr &&expr) { @@ -69,7 +75,7 @@ } private: - enum class Category { Explicit, Deferred, Assumed }; + enum class Category { Explicit, Star, Colon }; Bound(Category category) : category_{category} {} Bound(Category category, MaybeSubscriptIntExpr &&expr) : category_{category}, expr_{std::move(expr)} {} @@ -78,7 +84,8 @@ friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const Bound &); }; -// A type parameter value: integer expression or assumed or deferred. +// A type parameter value: integer expression, assumed/implied(*), +// or deferred(:). class ParamValue { public: static ParamValue Assumed(common::TypeParamAttr attr) { @@ -176,28 +183,26 @@ return MakeExplicit(Bound{1}, std::move(ub)); } // 1: - static ShapeSpec MakeAssumed() { - return ShapeSpec(Bound{1}, Bound::Deferred()); + static ShapeSpec MakeAssumedShape() { + return ShapeSpec(Bound{1}, Bound::Colon()); } // lb: - static ShapeSpec MakeAssumed(Bound &&lb) { - return ShapeSpec(std::move(lb), Bound::Deferred()); + static ShapeSpec MakeAssumedShape(Bound &&lb) { + return ShapeSpec(std::move(lb), Bound::Colon()); } // : static ShapeSpec MakeDeferred() { - return ShapeSpec(Bound::Deferred(), Bound::Deferred()); + return ShapeSpec(Bound::Colon(), Bound::Colon()); } // 1:* - static ShapeSpec MakeImplied() { - return ShapeSpec(Bound{1}, Bound::Assumed()); - } + static ShapeSpec MakeImplied() { return ShapeSpec(Bound{1}, Bound::Star()); } // lb:* static ShapeSpec MakeImplied(Bound &&lb) { - return ShapeSpec(std::move(lb), Bound::Assumed()); + return ShapeSpec(std::move(lb), Bound::Star()); } // .. static ShapeSpec MakeAssumedRank() { - return ShapeSpec(Bound::Assumed(), Bound::Assumed()); + return ShapeSpec(Bound::Star(), Bound::Star()); } ShapeSpec(const ShapeSpec &) = default; @@ -220,11 +225,15 @@ struct ArraySpec : public std::vector { ArraySpec() {} int Rank() const { return size(); } + // These names are not exclusive, as some categories cannot be + // distinguished without knowing whether the particular symbol + // is allocatable, pointer, or a non-allocatable non-pointer dummy. + // Use the symbol-based predicates for exact results. inline bool IsExplicitShape() const; - inline bool IsAssumedShape() const; - inline bool IsDeferredShape() const; - inline bool IsImpliedShape() const; - inline bool IsAssumedSize() const; + inline bool CanBeAssumedShape() const; + inline bool CanBeDeferredShape() const; + inline bool CanBeImpliedShape() const; + inline bool CanBeAssumedSize() const; inline bool IsAssumedRank() const; private: @@ -399,25 +408,25 @@ inline bool ArraySpec::IsExplicitShape() const { return CheckAll([](const ShapeSpec &x) { return x.ubound().isExplicit(); }); } -inline bool ArraySpec::IsAssumedShape() const { - return CheckAll([](const ShapeSpec &x) { return x.ubound().isDeferred(); }); +inline bool ArraySpec::CanBeAssumedShape() const { + return CheckAll([](const ShapeSpec &x) { return x.ubound().isColon(); }); } -inline bool ArraySpec::IsDeferredShape() const { +inline bool ArraySpec::CanBeDeferredShape() const { return CheckAll([](const ShapeSpec &x) { - return x.lbound().isDeferred() && x.ubound().isDeferred(); + return x.lbound().isColon() && x.ubound().isColon(); }); } -inline bool ArraySpec::IsImpliedShape() const { +inline bool ArraySpec::CanBeImpliedShape() const { return !IsAssumedRank() && - CheckAll([](const ShapeSpec &x) { return x.ubound().isAssumed(); }); + CheckAll([](const ShapeSpec &x) { return x.ubound().isStar(); }); } -inline bool ArraySpec::IsAssumedSize() const { - return !empty() && !IsAssumedRank() && back().ubound().isAssumed() && +inline bool ArraySpec::CanBeAssumedSize() const { + return !empty() && !IsAssumedRank() && back().ubound().isStar() && std::all_of(begin(), end() - 1, [](const ShapeSpec &x) { return x.ubound().isExplicit(); }); } inline bool ArraySpec::IsAssumedRank() const { - return Rank() == 1 && front().lbound().isAssumed(); + return Rank() == 1 && front().lbound().isStar(); } inline IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() { diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -189,21 +189,21 @@ } void TypeAndShape::AcquireAttrs(const semantics::Symbol &symbol) { + if (IsAssumedShape(symbol)) { + attrs_.set(Attr::AssumedShape); + } + if (IsDeferredShape(symbol)) { + attrs_.set(Attr::DeferredShape); + } if (const auto *object{ symbol.GetUltimate().detailsIf()}) { corank_ = object->coshape().Rank(); if (object->IsAssumedRank()) { attrs_.set(Attr::AssumedRank); } - if (object->IsAssumedShape()) { - attrs_.set(Attr::AssumedShape); - } if (object->IsAssumedSize()) { attrs_.set(Attr::AssumedSize); } - if (object->IsDeferredShape()) { - attrs_.set(Attr::DeferredShape); - } if (object->IsCoarray()) { attrs_.set(Attr::Coarray); } diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -659,18 +659,12 @@ // simple contiguity to allow their use in contexts like // data targets in pointer assignments with remapping. return true; - } else if (semantics::IsPointer(ultimate)) { + } else if (semantics::IsPointer(ultimate) || + semantics::IsAssumedShape(ultimate)) { return false; - } else if (semantics::IsAllocatable(ultimate)) { - // TODO: this could be merged with the case below if - // details->IsAssumedShape() did not return true for allocatables. Current - // ArraySpec building in semantics does not allow making a difference - // between some_assumed_shape(:) and some_allocatable(:). Both - // isDeferredShape() and isAssumedShape() are true in each case. - return true; } else if (const auto *details{ ultimate.detailsIf()}) { - return !details->IsAssumedShape() && !details->IsAssumedRank(); + return !details->IsAssumedRank(); } else if (auto assoc{Base::operator()(ultimate)}) { return assoc; } else { diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp --- a/flang/lib/Evaluate/shape.cpp +++ b/flang/lib/Evaluate/shape.cpp @@ -27,7 +27,7 @@ const Symbol &symbol{ResolveAssociations(original)}; const auto *details{symbol.detailsIf()}; return details && symbol.attrs().test(semantics::Attr::PARAMETER) && - details->shape().IsImpliedShape(); + details->shape().CanBeImpliedShape(); } bool IsExplicitShape(const Symbol &original) { diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1252,6 +1252,20 @@ ResolveAssociations(symbol).details()); } +bool IsAssumedShape(const Symbol &symbol) { + const Symbol &ultimate{ResolveAssociations(symbol)}; + const auto *object{ultimate.detailsIf()}; + return object && object->CanBeAssumedShape() && + !evaluate::IsAllocatableOrPointer(ultimate); +} + +bool IsDeferredShape(const Symbol &symbol) { + const Symbol &ultimate{ResolveAssociations(symbol)}; + const auto *object{ultimate.detailsIf()}; + return object && object->CanBeDeferredShape() && + evaluate::IsAllocatableOrPointer(ultimate); +} + bool IsFunctionResult(const Symbol &original) { const Symbol &symbol{GetAssociationRoot(original)}; return (symbol.has() && diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -436,8 +436,8 @@ for (auto &ss : details.shape()) { auto lb = ss.lbound(); auto ub = ss.ubound(); - if (lb.isAssumed() && ub.isAssumed() && size == 1) - return {}; + if (lb.isStar() && ub.isStar() && size == 1) + return {}; // assumed rank if (lb.isExplicit() && ub.isExplicit()) { auto &lbv = lb.GetExplicit(); auto &ubv = ub.GetExplicit(); diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -161,9 +161,13 @@ characteristics::TypeAndShape::Attr::AssumedRank)) { } else if (!dummy.type.attrs().test( characteristics::TypeAndShape::Attr::AssumedShape) && + !dummy.type.attrs().test( + characteristics::TypeAndShape::Attr::DeferredShape) && (actualType.Rank() > 0 || IsArrayElement(actual))) { // Sequence association (15.5.2.11) applies -- rank need not match - // if the actual argument is an array or array element designator. + // if the actual argument is an array or array element designator, + // and the dummy is not assumed-shape or an INTENT(IN) pointer + // that's standing in for an assumed-shape dummy. } else { // Let CheckConformance accept scalars; storage association // cases are checked here below. @@ -322,7 +326,7 @@ "Scalar POINTER target may not be associated with a %s array"_err_en_US, dummyName); } - if (actualLastObject && actualLastObject->IsAssumedShape()) { + if (actualLastSymbol && IsAssumedShape(*actualLastSymbol)) { messages.Say( "Element of assumed-shape array may not be associated with a %s array"_err_en_US, dummyName); @@ -362,13 +366,13 @@ } // Cases when temporaries might be needed but must not be permitted. + bool actualIsContiguous{IsSimplyContiguous(actual, context)}; + bool dummyIsAssumedShape{dummy.type.attrs().test( + characteristics::TypeAndShape::Attr::AssumedShape)}; bool dummyIsPointer{ dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer)}; bool dummyIsContiguous{ dummy.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)}; - bool actualIsContiguous{IsSimplyContiguous(actual, context)}; - bool dummyIsAssumedShape{dummy.type.attrs().test( - characteristics::TypeAndShape::Attr::AssumedShape)}; if ((actualIsAsynchronous || actualIsVolatile) && (dummyIsAsynchronous || dummyIsVolatile) && !dummyIsValue) { if (actualIsCoindexed) { // C1538 @@ -675,9 +679,10 @@ messages.Say( "Assumed-type '%s' may be associated only with an assumed-type %s"_err_en_US, assumed.name(), dummyName); - } else if (const auto *details{ - assumed.detailsIf()}) { - if (!(details->IsAssumedShape() || details->IsAssumedRank())) { + } else { + const auto *details{assumed.detailsIf()}; + if (!(IsAssumedShape(assumed) || + (details && details->IsAssumedRank()))) { messages.Say( // C711 "Assumed-type '%s' must be either assumed shape or assumed rank to be associated with assumed-type %s"_err_en_US, assumed.name(), dummyName); diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -455,7 +455,7 @@ CheckAssumedTypeEntity(symbol, details); WarnMissingFinal(symbol); if (!details.coshape().empty()) { - bool isDeferredCoshape{details.coshape().IsDeferredShape()}; + bool isDeferredCoshape{details.coshape().CanBeDeferredShape()}; if (IsAllocatable(symbol)) { if (!isDeferredCoshape) { // C827 messages_.Say("'%s' is an ALLOCATABLE coarray and must have a deferred" @@ -469,7 +469,7 @@ " attribute%s"_err_en_US, symbol.name(), deferredMsg); } else { - if (!details.coshape().IsAssumedSize()) { // C828 + if (!details.coshape().CanBeAssumedSize()) { // C828 messages_.Say( "'%s' is a non-ALLOCATABLE coarray and must have an explicit coshape"_err_en_US, symbol.name()); @@ -670,16 +670,18 @@ return; } bool isExplicit{arraySpec.IsExplicitShape()}; - bool isDeferred{arraySpec.IsDeferredShape()}; - bool isImplied{arraySpec.IsImpliedShape()}; - bool isAssumedShape{arraySpec.IsAssumedShape()}; - bool isAssumedSize{arraySpec.IsAssumedSize()}; + bool canBeDeferred{arraySpec.CanBeDeferredShape()}; + bool canBeImplied{arraySpec.CanBeImpliedShape()}; + bool canBeAssumedShape{arraySpec.CanBeAssumedShape()}; + bool canBeAssumedSize{arraySpec.CanBeAssumedSize()}; bool isAssumedRank{arraySpec.IsAssumedRank()}; std::optional msg; - if (symbol.test(Symbol::Flag::CrayPointee) && !isExplicit && !isAssumedSize) { + if (symbol.test(Symbol::Flag::CrayPointee) && !isExplicit && + !canBeAssumedSize) { msg = "Cray pointee '%s' must have must have explicit shape or" " assumed size"_err_en_US; - } else if (IsAllocatableOrPointer(symbol) && !isDeferred && !isAssumedRank) { + } else if (IsAllocatableOrPointer(symbol) && !canBeDeferred && + !isAssumedRank) { if (symbol.owner().IsDerivedType()) { // C745 if (IsAllocatable(symbol)) { msg = "Allocatable array component '%s' must have" @@ -697,22 +699,22 @@ } } } else if (IsDummy(symbol)) { - if (isImplied && !isAssumedSize) { // C836 + if (canBeImplied && !canBeAssumedSize) { // C836 msg = "Dummy array argument '%s' may not have implied shape"_err_en_US; } - } else if (isAssumedShape && !isDeferred) { + } else if (canBeAssumedShape && !canBeDeferred) { msg = "Assumed-shape array '%s' must be a dummy argument"_err_en_US; - } else if (isAssumedSize && !isImplied) { // C833 + } else if (canBeAssumedSize && !canBeImplied) { // C833 msg = "Assumed-size array '%s' must be a dummy argument"_err_en_US; } else if (isAssumedRank) { // C837 msg = "Assumed-rank array '%s' must be a dummy argument"_err_en_US; - } else if (isImplied) { + } else if (canBeImplied) { if (!IsNamedConstant(symbol)) { // C835, C836 msg = "Implied-shape array '%s' must be a named constant or a " "dummy argument"_err_en_US; } } else if (IsNamedConstant(symbol)) { - if (!isExplicit && !isImplied) { + if (!isExplicit && !canBeImplied) { msg = "Named constant '%s' array must have constant or" " implied shape"_err_en_US; } @@ -1965,15 +1967,13 @@ if (CheckDioDummyIsData(subp, arg, argPosition)) { CheckDioDummyIsDefaultInteger(subp, *arg); CheckDioDummyAttrs(subp, *arg, Attr::INTENT_IN); - if (const auto *objectDetails{arg->detailsIf()}) { - if (objectDetails->shape().IsDeferredShape()) { - return; - } + const auto *objectDetails{arg->detailsIf()}; + if (!objectDetails || !objectDetails->shape().CanBeDeferredShape()) { + messages_.Say(arg->name(), + "Dummy argument '%s' of a defined input/output procedure must be" + " deferred shape"_err_en_US, + arg->name()); } - messages_.Say(arg->name(), - "Dummy argument '%s' of a defined input/output procedure must be" - " deferred shape"_err_en_US, - arg->name()); } } diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -531,15 +531,15 @@ } void PutShapeSpec(llvm::raw_ostream &os, const ShapeSpec &x) { - if (x.lbound().isAssumed()) { - CHECK(x.ubound().isAssumed()); - os << ".."; + if (x.lbound().isStar()) { + CHECK(x.ubound().isStar()); + os << ".."; // assumed rank } else { - if (!x.lbound().isDeferred()) { + if (!x.lbound().isColon()) { PutBound(os, x.lbound()); } os << ':'; - if (!x.ubound().isDeferred()) { + if (!x.ubound().isColon()) { PutBound(os, x.ubound()); } } @@ -639,9 +639,9 @@ } void PutBound(llvm::raw_ostream &os, const Bound &x) { - if (x.isAssumed()) { + if (x.isStar()) { os << '*'; - } else if (x.isDeferred()) { + } else if (x.isColon()) { os << ':'; } else { x.GetExplicit()->AsFortran(os); diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp --- a/flang/lib/Semantics/resolve-names-utils.cpp +++ b/flang/lib/Semantics/resolve-names-utils.cpp @@ -303,7 +303,7 @@ } void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeSpec &x) { - arraySpec_.push_back(ShapeSpec::MakeAssumed(GetBound(x.v))); + arraySpec_.push_back(ShapeSpec::MakeAssumedShape(GetBound(x.v))); } void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeSpec &x) { MakeExplicit(std::get>(x.t), diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -531,9 +531,9 @@ Bound::Bound(common::ConstantSubscript bound) : expr_{bound} {} llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const Bound &x) { - if (x.isAssumed()) { + if (x.isStar()) { o << '*'; - } else if (x.isDeferred()) { + } else if (x.isColon()) { o << ':'; } else if (x.expr_) { x.expr_->AsFortran(o); @@ -544,15 +544,15 @@ } llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const ShapeSpec &x) { - if (x.lb_.isAssumed()) { - CHECK(x.ub_.isAssumed()); + if (x.lb_.isStar()) { + CHECK(x.ub_.isStar()); o << ".."; } else { - if (!x.lb_.isDeferred()) { + if (!x.lb_.isColon()) { o << x.lb_; } o << ':'; - if (!x.ub_.isDeferred()) { + if (!x.ub_.isColon()) { o << x.ub_; } }