}
void PutShapeSpec(std::ostream &os, const ShapeSpec &x) {
- if (x.ubound().isAssumed()) {
+ if (x.lbound().isAssumed()) {
CHECK(x.ubound().isAssumed());
os << "..";
} else {
}
}
}
-void PutShape(std::ostream &os, const ArraySpec &shape) {
+void PutShape(std::ostream &os, const ArraySpec &shape, char open, char close) {
if (!shape.empty()) {
- os << '(';
+ os << open;
bool first{true};
for (const auto &shapeSpec : shape) {
if (first) {
}
PutShapeSpec(os, shapeSpec);
}
- os << ')';
+ os << close;
}
}
CHECK(type);
PutLower(os, *type);
});
- PutShape(os, details.shape());
+ PutShape(os, details.shape(), '(', ')');
+ PutShape(os, details.coshape(), '[', ']');
PutInit(os, details.init());
}
DoBound(spec.lbound());
DoBound(spec.ubound());
}
+ for (const ShapeSpec &spec : details.coshape()) {
+ DoBound(spec.lbound());
+ DoBound(spec.ubound());
+ }
if (const Symbol * commonBlock{details.commonBlock()}) {
DoSymbol(*commonBlock);
}
// limitations under the License.
#include "resolve-names-utils.h"
+#include "expression.h"
#include "semantics.h"
-#include "symbol.h"
-#include "type.h"
#include "../common/idioms.h"
+#include "../evaluate/fold.h"
+#include "../evaluate/tools.h"
+#include "../evaluate/type.h"
#include "../parser/char-block.h"
#include "../parser/features.h"
#include "../parser/parse-tree.h"
}
}
+class ArraySpecAnalyzer {
+public:
+ ArraySpecAnalyzer(ArraySpec &arraySpec, SemanticsContext &context)
+ : context_{context}, arraySpec_{arraySpec} {
+ CHECK(arraySpec.empty());
+ }
+ void Analyze(const parser::ArraySpec &);
+ void Analyze(const parser::CoarraySpec &);
+
+private:
+ SemanticsContext &context_;
+ ArraySpec &arraySpec_;
+
+ template<typename T> void Analyze(const std::list<T> &list) {
+ for (const auto &elem : list) {
+ Analyze(elem);
+ }
+ }
+ void Analyze(const parser::AssumedShapeSpec &);
+ void Analyze(const parser::ExplicitShapeSpec &);
+ void Analyze(const parser::AssumedImpliedSpec &);
+ void Analyze(const parser::AssumedRankSpec &);
+ void MakeExplicit(const std::optional<parser::SpecificationExpr> &,
+ const parser::SpecificationExpr &);
+ void MakeImplied(const std::optional<parser::SpecificationExpr> &);
+ void MakeDeferred(int);
+ Bound GetBound(const std::optional<parser::SpecificationExpr> &);
+ Bound GetBound(const parser::SpecificationExpr &);
+};
+
+void AnalyzeArraySpec(ArraySpec &result, SemanticsContext &context,
+ const parser::ArraySpec &arraySpec) {
+ ArraySpecAnalyzer{result, context}.Analyze(arraySpec);
+}
+void AnalyzeCoarraySpec(ArraySpec &result, SemanticsContext &context,
+ const parser::CoarraySpec &coarraySpec) {
+ ArraySpecAnalyzer{result, context}.Analyze(coarraySpec);
+}
+
+void ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x) {
+ std::visit(
+ common::visitors{
+ [&](const parser::DeferredShapeSpecList &y) { MakeDeferred(y.v); },
+ [&](const parser::AssumedSizeSpec &y) {
+ Analyze(std::get<std::list<parser::ExplicitShapeSpec>>(y.t));
+ Analyze(std::get<parser::AssumedImpliedSpec>(y.t));
+ },
+ [&](const parser::ImpliedShapeSpec &y) { Analyze(y.v); },
+ [&](const auto &y) { Analyze(y); },
+ },
+ x.u);
+}
+void ArraySpecAnalyzer::Analyze(const parser::CoarraySpec &x) {
+ std::visit(
+ common::visitors{
+ [&](const parser::DeferredCoshapeSpecList &y) { MakeDeferred(y.v); },
+ [&](const parser::ExplicitCoshapeSpec &y) {
+ Analyze(std::get<std::list<parser::ExplicitShapeSpec>>(y.t));
+ MakeImplied(
+ std::get<std::optional<parser::SpecificationExpr>>(y.t));
+ },
+ },
+ x.u);
+}
+
+void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeSpec &x) {
+ arraySpec_.push_back(ShapeSpec::MakeAssumed(GetBound(x.v)));
+}
+void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeSpec &x) {
+ MakeExplicit(std::get<std::optional<parser::SpecificationExpr>>(x.t),
+ std::get<parser::SpecificationExpr>(x.t));
+}
+void ArraySpecAnalyzer::Analyze(const parser::AssumedImpliedSpec &x) {
+ MakeImplied(x.v);
+}
+void ArraySpecAnalyzer::Analyze(const parser::AssumedRankSpec &) {
+ arraySpec_.push_back(ShapeSpec::MakeAssumedRank());
+}
+
+void ArraySpecAnalyzer::MakeExplicit(
+ const std::optional<parser::SpecificationExpr> &lb,
+ const parser::SpecificationExpr &ub) {
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(GetBound(lb), GetBound(ub)));
+}
+void ArraySpecAnalyzer::MakeImplied(
+ const std::optional<parser::SpecificationExpr> &lb) {
+ arraySpec_.push_back(ShapeSpec::MakeImplied(GetBound(lb)));
+}
+void ArraySpecAnalyzer::MakeDeferred(int n) {
+ for (int i = 0; i < n; ++i) {
+ arraySpec_.push_back(ShapeSpec::MakeDeferred());
+ }
+}
+
+Bound ArraySpecAnalyzer::GetBound(
+ const std::optional<parser::SpecificationExpr> &x) {
+ return x ? GetBound(*x) : Bound{1};
+}
+Bound ArraySpecAnalyzer::GetBound(const parser::SpecificationExpr &x) {
+ MaybeSubscriptIntExpr expr;
+ if (MaybeExpr maybeExpr{AnalyzeExpr(context_, x.v)}) {
+ if (auto *intExpr{evaluate::UnwrapExpr<SomeIntExpr>(*maybeExpr)}) {
+ expr = evaluate::Fold(context_.foldingContext(),
+ evaluate::ConvertToType<evaluate::SubscriptInteger>(
+ std::move(*intExpr)));
+ }
+ }
+ return Bound{std::move(expr)};
+}
+
}
// Utility functions and class for use in resolve-names.cc.
#include "symbol.h"
+#include "type.h"
#include "../parser/message.h"
namespace Fortran::parser {
class CharBlock;
+struct ArraySpec;
+struct CoarraySpec;
struct DefinedOpName;
struct GenericSpec;
struct Name;
namespace Fortran::semantics {
using SourceName = parser::CharBlock;
+class SemanticsContext;
// Record that a Name has been resolved to a Symbol
Symbol &Resolve(const parser::Name &, Symbol &);
void Analyze(const parser::GenericSpec &);
};
+// Analyze a parser::ArraySpec or parser::CoarraySpec into the provide ArraySpec
+void AnalyzeArraySpec(
+ ArraySpec &, SemanticsContext &, const parser::ArraySpec &);
+void AnalyzeCoarraySpec(
+ ArraySpec &, SemanticsContext &, const parser::CoarraySpec &);
+
}
#endif // FORTRAN_SEMANTICS_RESOLVE_NAMES_H_
// 6. TODO: BasedPointerStmt
class ArraySpecVisitor : public virtual BaseVisitor {
public:
- bool Pre(const parser::ArraySpec &);
+ void Post(const parser::ArraySpec &);
+ void Post(const parser::CoarraySpec &);
void Post(const parser::AttrSpec &) { PostAttrSpec(); }
void Post(const parser::ComponentAttrSpec &) { PostAttrSpec(); }
- void Post(const parser::DeferredShapeSpecList &);
- void Post(const parser::AssumedShapeSpec &);
- void Post(const parser::ExplicitShapeSpec &);
- void Post(const parser::AssumedImpliedSpec &);
- void Post(const parser::AssumedRankSpec &);
protected:
const ArraySpec &arraySpec();
+ const ArraySpec &coarraySpec();
void BeginArraySpec();
void EndArraySpec();
void ClearArraySpec() { arraySpec_.clear(); }
+ void ClearCoarraySpec() { coarraySpec_.clear(); }
private:
- // arraySpec_ is populated by any ArraySpec
+ // arraySpec_/coarraySpec_ are populated from any ArraySpec/CoarraySpec
ArraySpec arraySpec_;
+ ArraySpec coarraySpec_;
// When an ArraySpec is under an AttrSpec or ComponentAttrSpec, it is moved
// into attrArraySpec_
ArraySpec attrArraySpec_;
+ ArraySpec attrCoarraySpec_;
void PostAttrSpec();
- Bound GetBound(const parser::SpecificationExpr &);
};
// Manage a stack of Scopes
public virtual ScopeHandler {
public:
using ArraySpecVisitor::Post;
- using ArraySpecVisitor::Pre;
using ScopeHandler::Post;
using ScopeHandler::Pre;
}
void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; }
void Post(const parser::DimensionStmt::Declaration &);
+ void Post(const parser::CodimensionDecl &);
bool Pre(const parser::TypeDeclarationStmt &) { return BeginDecl(); }
void Post(const parser::TypeDeclarationStmt &) { EndDecl(); }
void Post(const parser::IntegerTypeSpec &);
public ConstructVisitor {
public:
using ArraySpecVisitor::Post;
- using ArraySpecVisitor::Pre;
using ConstructVisitor::Post;
using ConstructVisitor::Pre;
using DeclarationVisitor::Post;
// ArraySpecVisitor implementation
-bool ArraySpecVisitor::Pre(const parser::ArraySpec &x) {
- CHECK(arraySpec_.empty());
- return true;
+void ArraySpecVisitor::Post(const parser::ArraySpec &x) {
+ AnalyzeArraySpec(arraySpec_, context(), x);
}
-
-void ArraySpecVisitor::Post(const parser::DeferredShapeSpecList &x) {
- for (int i = 0; i < x.v; ++i) {
- arraySpec_.push_back(ShapeSpec::MakeDeferred());
- }
-}
-
-void ArraySpecVisitor::Post(const parser::AssumedShapeSpec &x) {
- const auto &lb{x.v};
- arraySpec_.push_back(
- lb ? ShapeSpec::MakeAssumed(GetBound(*lb)) : ShapeSpec::MakeAssumed());
-}
-
-void ArraySpecVisitor::Post(const parser::ExplicitShapeSpec &x) {
- auto &&ub{GetBound(std::get<parser::SpecificationExpr>(x.t))};
- if (const auto &lb{std::get<std::optional<parser::SpecificationExpr>>(x.t)}) {
- arraySpec_.push_back(ShapeSpec::MakeExplicit(GetBound(*lb), std::move(ub)));
- } else {
- arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}, std::move(ub)));
- }
-}
-
-void ArraySpecVisitor::Post(const parser::AssumedImpliedSpec &x) {
- const auto &lb{x.v};
- arraySpec_.push_back(
- lb ? ShapeSpec::MakeImplied(GetBound(*lb)) : ShapeSpec::MakeImplied());
-}
-
-void ArraySpecVisitor::Post(const parser::AssumedRankSpec &) {
- arraySpec_.push_back(ShapeSpec::MakeAssumedRank());
+void ArraySpecVisitor::Post(const parser::CoarraySpec &x) {
+ AnalyzeCoarraySpec(coarraySpec_, context(), x);
}
const ArraySpec &ArraySpecVisitor::arraySpec() {
return !arraySpec_.empty() ? arraySpec_ : attrArraySpec_;
}
+const ArraySpec &ArraySpecVisitor::coarraySpec() {
+ return !coarraySpec_.empty() ? coarraySpec_ : attrCoarraySpec_;
+}
void ArraySpecVisitor::BeginArraySpec() {
CHECK(arraySpec_.empty());
+ CHECK(coarraySpec_.empty());
CHECK(attrArraySpec_.empty());
+ CHECK(attrCoarraySpec_.empty());
}
void ArraySpecVisitor::EndArraySpec() {
CHECK(arraySpec_.empty());
+ CHECK(coarraySpec_.empty());
attrArraySpec_.clear();
+ attrCoarraySpec_.clear();
}
void ArraySpecVisitor::PostAttrSpec() {
+ // Save dimension/codimension from attrs so we can process array/coarray-spec
+ // on the entity-decl
if (!arraySpec_.empty()) {
- // Example: integer, dimension(<1>) :: x(<2>)
- // This saves <1> in attrArraySpec_ so we can process <2> into arraySpec_
CHECK(attrArraySpec_.empty());
attrArraySpec_.splice(attrArraySpec_.cbegin(), arraySpec_);
- CHECK(arraySpec_.empty());
}
-}
-
-Bound ArraySpecVisitor::GetBound(const parser::SpecificationExpr &x) {
- return Bound{EvaluateSubscriptIntExpr(x.v)};
+ if (!coarraySpec_.empty()) {
+ CHECK(attrCoarraySpec_.empty());
+ attrCoarraySpec_.splice(attrCoarraySpec_.cbegin(), coarraySpec_);
+ }
}
// ScopeHandler implementation
const auto &name{std::get<parser::Name>(x.t)};
DeclareObjectEntity(name, Attrs{});
}
+void DeclarationVisitor::Post(const parser::CodimensionDecl &x) {
+ const auto &name{std::get<parser::Name>(x.t)};
+ DeclareObjectEntity(name, Attrs{});
+}
+//TODO: ChangeTeamStmt also uses CodimensionDecl
void DeclarationVisitor::Post(const parser::EntityDecl &x) {
// TODO: may be under StructureStmt
// Declare an entity not yet known to be an object or proc.
Symbol &DeclarationVisitor::DeclareUnknownEntity(
const parser::Name &name, Attrs attrs) {
- if (!arraySpec().empty()) {
+ if (!arraySpec().empty() || !coarraySpec().empty()) {
return DeclareObjectEntity(name, attrs);
} else {
Symbol &symbol{DeclareEntity<EntityDetails>(name, attrs)};
}
ClearArraySpec();
}
+ if (!coarraySpec().empty()) {
+ if (details->IsCoarray()) {
+ Say(name,
+ "The codimensions of '%s' have already been declared"_err_en_US);
+ } else {
+ details->set_coshape(coarraySpec());
+ }
+ ClearCoarraySpec();
+ }
SetBindNameOn(symbol);
}
return symbol;
currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);
}
ClearArraySpec();
+ ClearCoarraySpec();
}
bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &) {
CHECK(!interfaceName_);
const auto &name{std::get<parser::Name>(x.t)};
auto &symbol{DeclareObjectEntity(name, Attrs{})};
ClearArraySpec();
+ ClearCoarraySpec();
auto *details{symbol.detailsIf<ObjectEntityDetails>()};
if (!details) {
return; // error was reported
return os << name.ToString();
}
+template<typename T>
+static void DumpOptional(
+ std::ostream &os, const char *label, const std::optional<T> &x) {
+ if (x) {
+ os << ' ' << label << ':' << *x;
+ }
+}
+
+static void DumpBool(std::ostream &os, const char *label, bool x) {
+ if (x) {
+ os << ' ' << label;
+ }
+}
+
+static void DumpSymbolList(std::ostream &os, const SymbolList &list) {
+ char sep{' '};
+ for (const auto *elem : list) {
+ os << sep << elem->name();
+ sep = ',';
+ }
+}
+
+static void DumpType(std::ostream &os, const Symbol &symbol) {
+ if (const auto *type{symbol.GetType()}) {
+ os << *type << ' ';
+ }
+}
+static void DumpType(std::ostream &os, const DeclTypeSpec *type) {
+ if (type) {
+ os << ' ' << *type;
+ }
+}
+
+template<typename T>
+static void DumpList(
+ std::ostream &os, const char *label, const std::list<T> &list) {
+ if (!list.empty()) {
+ os << ' ' << label << ':';
+ char sep{' '};
+ for (const auto &elem : list) {
+ os << sep << elem;
+ sep = ',';
+ }
+ }
+}
+
const Scope *ModuleDetails::parent() const {
return isSubmodule_ && scope_ ? &scope_->parent() : nullptr;
}
}
std::ostream &operator<<(std::ostream &os, const SubprogramDetails &x) {
- if (x.isInterface_) {
- os << " isInterface";
- }
- if (x.bindName_) {
- os << " bindName:" << x.bindName_;
- }
+ DumpBool(os, "isInterface", x.isInterface_);
+ DumpOptional(os, "bindName", x.bindName_);
if (x.result_) {
os << " result:" << x.result_->name();
if (!x.result_->attrs().empty()) {
shape_.push_back(shapeSpec);
}
}
+void ObjectEntityDetails::set_coshape(const ArraySpec &coshape) {
+ CHECK(coshape_.empty());
+ for (const auto &shapeSpec : coshape) {
+ coshape_.push_back(shapeSpec);
+ }
+}
ProcEntityDetails::ProcEntityDetails(EntityDetails &&d) : EntityDetails(d) {
if (type()) {
: EntityDetails(d) {}
std::ostream &operator<<(std::ostream &os, const EntityDetails &x) {
- if (x.isDummy()) {
- os << " dummy";
- }
- if (x.isFuncResult()) {
- os << " funcResult";
- }
+ DumpBool(os, "dummy", x.isDummy());
+ DumpBool(os, "funcResult", x.isFuncResult());
if (x.type()) {
os << " type: " << *x.type();
}
- if (x.bindName_) {
- os << " bindName:" << x.bindName_;
- }
+ DumpOptional(os, "bindName", x.bindName_);
return os;
}
std::ostream &operator<<(std::ostream &os, const ObjectEntityDetails &x) {
os << *static_cast<const EntityDetails *>(&x);
- if (!x.shape().empty()) {
- os << " shape:";
- for (const auto &s : x.shape()) {
- os << ' ' << s;
- }
- }
- if (x.init_) {
- os << " init:" << x.init_;
- }
+ DumpList(os, "shape", x.shape());
+ DumpList(os, "coshape", x.coshape());
+ DumpOptional(os, "init", x.init_);
return os;
}
std::ostream &operator<<(std::ostream &os, const AssocEntityDetails &x) {
os << *static_cast<const EntityDetails *>(&x);
- if (x.expr().has_value()) {
- os << ' ' << x.expr();
- }
+ DumpOptional(os, "expr", x.expr());
return os;
}
std::ostream &operator<<(std::ostream &os, const ProcEntityDetails &x) {
if (auto *symbol{x.interface_.symbol()}) {
os << ' ' << symbol->name();
- } else if (auto *type{x.interface_.type()}) {
- os << ' ' << *type;
- }
- if (x.bindName()) {
- os << " bindName:" << x.bindName();
- }
- if (x.passName_) {
- os << " passName:" << *x.passName_;
+ } else {
+ DumpType(os, x.interface_.type());
}
+ DumpOptional(os, "bindName", x.bindName());
+ DumpOptional(os, "passName", x.passName());
return os;
}
std::ostream &operator<<(std::ostream &os, const DerivedTypeDetails &x) {
- if (x.sequence_) {
- os << " sequence";
- }
- if (!x.componentNames_.empty()) {
- os << " components:";
- for (auto name : x.componentNames_) {
- os << ' ' << name.ToString();
- }
- }
- return os;
-}
-
-static std::ostream &DumpType(std::ostream &os, const Symbol &symbol) {
- if (const auto *type{symbol.GetType()}) {
- os << *type << ' ';
- }
+ DumpBool(os, "sequence", x.sequence_);
+ DumpList(os, "components", x.componentNames_);
return os;
}
os << dummy->name();
}
os << ')';
- if (x.bindName()) {
- os << " bindName:" << x.bindName();
- }
+ DumpOptional(os, "bindName", x.bindName());
if (x.isFunction()) {
os << " result(";
DumpType(os, x.result());
os << x.result().name() << ')';
}
- if (x.isInterface()) {
- os << " interface";
- }
+ DumpBool(os, "interface", x.isInterface());
},
[&](const SubprogramNameDetails &x) {
os << ' ' << EnumToString(x.kind());
[](const HostAssocDetails &) {},
[&](const GenericDetails &x) {
os << ' ' << EnumToString(x.kind());
- for (const auto *proc : x.specificProcs()) {
- os << ' ' << proc->name();
- }
+ DumpSymbolList(os, x.specificProcs());
},
[&](const ProcBindingDetails &x) {
os << " => " << x.symbol().name();
- if (x.passName()) {
- os << " passName:" << *x.passName();
- }
+ DumpOptional(os, "passName", x.passName());
},
[&](const GenericBindingDetails &x) {
os << " =>";
- char sep{' '};
- for (const auto *proc : x.specificProcs()) {
- os << sep << proc->name();
- sep = ',';
- }
+ DumpSymbolList(os, x.specificProcs());
},
[&](const NamelistDetails &x) {
os << ':';
- for (const auto *object : x.objects()) {
- os << ' ' << object->name();
- }
+ DumpSymbolList(os, x.objects());
},
[&](const CommonBlockDetails &x) {
os << ':';
os << ' ' << *x.type();
}
os << ' ' << common::EnumToString(x.attr());
- if (x.init()) {
- os << " init:" << x.init();
- }
+ DumpOptional(os, "init", x.init());
},
[&](const MiscDetails &x) {
os << ' ' << MiscDetails::EnumToString(x.kind());
if (!symbol.attrs().empty()) {
os << ' ' << symbol.attrs();
}
- if (symbol.test(Symbol::Flag::Implicit)) {
- os << " (implicit)";
- }
- if (symbol.test(Symbol::Flag::LocalityLocal)) {
- os << " (local)";
- }
- if (symbol.test(Symbol::Flag::LocalityLocalInit)) {
- os << " (local_init)";
- }
- if (symbol.test(Symbol::Flag::LocalityShared)) {
- os << " (shared)";
- }
+ DumpBool(os, "(implicit)", symbol.test(Symbol::Flag::Implicit));
+ DumpBool(os, "(local)", symbol.test(Symbol::Flag::LocalityLocal));
+ DumpBool(os, "(local_init)", symbol.test(Symbol::Flag::LocalityLocalInit));
+ DumpBool(os, "(shared)", symbol.test(Symbol::Flag::LocalityShared));
os << ' ' << symbol.GetDetailsName();
- if (const auto *type{symbol.GetType()}) {
- os << ' ' << *type;
- }
+ DumpType(os, symbol.GetType());
}
return os;
}
foldingContext, std::move(dim.ubound().GetExplicit())));
}
}
- // TODO: fold cobounds too once we can represent them
+ for (ShapeSpec &dim : details.coshape()) {
+ if (dim.lbound().isExplicit()) {
+ dim.lbound().SetExplicit(Fold(
+ foldingContext, std::move(dim.lbound().GetExplicit())));
+ }
+ if (dim.ubound().isExplicit()) {
+ dim.ubound().SetExplicit(Fold(
+ foldingContext, std::move(dim.ubound().GetExplicit())));
+ }
+ }
},
[&](const ProcBindingDetails &that) { symbol.details_ = that; },
[&](const GenericBindingDetails &that) { symbol.details_ = that; },
CHECK(type_ == nullptr);
type_ = &type;
}
+
}
void set_init(MaybeExpr &&expr) { init_ = std::move(expr); }
ArraySpec &shape() { return shape_; }
const ArraySpec &shape() const { return shape_; }
- void set_shape(const ArraySpec &shape);
+ ArraySpec &coshape() { return coshape_; }
+ const ArraySpec &coshape() const { return coshape_; }
+ void set_shape(const ArraySpec &);
+ void set_coshape(const ArraySpec &);
const Symbol *commonBlock() const { return commonBlock_; }
void set_commonBlock(const Symbol &commonBlock) { commonBlock_ = &commonBlock; }
bool IsArray() const { return !shape_.empty(); }
+ bool IsCoarray() const { return !coshape_.empty(); }
bool IsAssumedShape() const {
return isDummy() && IsArray() && shape_.back().ubound().isDeferred() &&
!shape_.back().lbound().isDeferred();
private:
MaybeExpr init_;
ArraySpec shape_;
+ ArraySpec coshape_;
const Symbol *commonBlock_{nullptr}; // common block this object is in
friend std::ostream &operator<<(std::ostream &, const ObjectEntityDetails &);
};
return std::visit(
common::visitors{
[](const SubprogramDetails &sd) {
- if (sd.isFunction()) {
- return sd.result().Rank();
- } else {
- return 0;
- }
+ return sd.isFunction() ? sd.result().Rank() : 0;
},
[](const GenericDetails &) {
return 0; /*TODO*/
details_);
}
+ int Corank() const {
+ return std::visit(
+ common::visitors{
+ [](const SubprogramDetails &sd) {
+ return sd.isFunction() ? sd.result().Corank() : 0;
+ },
+ [](const GenericDetails &) {
+ return 0; /*TODO*/
+ },
+ [](const UseDetails &x) { return x.symbol().Corank(); },
+ [](const HostAssocDetails &x) { return x.symbol().Corank(); },
+ [](const ObjectEntityDetails &oed) {
+ return static_cast<int>(oed.coshape().size());
+ },
+ [](const auto &) { return 0; },
+ },
+ details_);
+ }
+
// Clones the Symbol in the context of a parameterized derived type instance
Symbol &Instantiate(Scope &, SemanticsContext &) const;
modfile21.f90
modfile22.f90
modfile23.f90
+ modfile24.f90
)
set(LABEL_TESTS
--- /dev/null
+! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+! http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! Test declarations with coarray-spec
+
+! Different ways of declaring the same coarray.
+module m1
+ real :: a(1:5)[1:10,1:*]
+ real, dimension(5) :: b[1:10,1:*]
+ real, codimension[1:10,1:*] :: c(5)
+ real, codimension[1:10,1:*], dimension(5) :: d
+ codimension :: e[1:10,1:*]
+ dimension :: e(5)
+ real :: e
+end
+!Expect: m1.mod
+!module m1
+! real(4)::a(1_8:5_8)[1_8:10_8,1_8:*]
+! real(4)::b(1_8:5_8)[1_8:10_8,1_8:*]
+! real(4)::c(1_8:5_8)[1_8:10_8,1_8:*]
+! real(4)::d(1_8:5_8)[1_8:10_8,1_8:*]
+! real(4)::e(1_8:5_8)[1_8:10_8,1_8:*]
+!end
+
+! coarray-spec in codimension and target statements.
+module m2
+ codimension :: a[10,*], b[*]
+ target :: c[10,*], d[*]
+end
+!Expect: m2.mod
+!module m2
+! real(4)::a[1_8:10_8,1_8:*]
+! real(4)::b[1_8:*]
+! real(4),target::c[1_8:10_8,1_8:*]
+! real(4),target::d[1_8:*]
+!end
+
+! coarray-spec in components and with non-constants bounds
+module m3
+ type t
+ real :: c(1:5)[1:10,1:*]
+ complex, codimension[5,*] :: d
+ end type
+ real, allocatable :: e[:,:,:]
+contains
+ subroutine s(a, b, n)
+ integer(8) :: n
+ real :: a[1:n,2:*]
+ real, codimension[1:n,2:*] :: b
+ end
+end
+!Expect: m3.mod
+!module m3
+! type::t
+! real(4)::c[1_8:10_8,1_8:*]
+! complex(4)::d[1_8:5_8,1_8:*]
+! end type
+! real(4),allocatable::e[:,:,:]
+!contains
+! subroutine s(a,b,n)
+! integer(8)::n
+! real(4)::a[1_8:n,2_8:*]
+! real(4)::b[1_8:n,2_8:*]
+! end
+!end
+
+! coarray-spec in both attributes and entity-decl
+module m4
+ real, codimension[2:*], dimension(2:5) :: a, b(4,4), c[10,*], d(4,4)[10,*]
+end
+!Expect: m4.mod
+!module m4
+! real(4)::a(2_8:5_8)[2_8:*]
+! real(4)::b(1_8:4_8,1_8:4_8)[2_8:*]
+! real(4)::c(2_8:5_8)[1_8:10_8,1_8:*]
+! real(4)::d(1_8:4_8,1_8:4_8)[1_8:10_8,1_8:*]
+!end
integer :: x(2)
!ERROR: The dimensions of 'x' have already been declared
allocatable :: x(:)
+ real :: y[1:*]
+ !ERROR: The codimensions of 'y' have already been declared
+ allocatable :: y[:]
end
subroutine s2
target :: x(1)
!ERROR: The dimensions of 'x' have already been declared
integer :: x(2)
+ target :: y[1:*]
+ !ERROR: The codimensions of 'y' have already been declared
+ integer :: y[2:*]
end
subroutine s3
- dimension :: x(4), y(8)
+ dimension :: x(4), x2(8)
!ERROR: The dimensions of 'x' have already been declared
allocatable :: x(:)
+ codimension :: y[*], y2[1:2,2:*]
+ !ERROR: The codimensions of 'y' have already been declared
+ allocatable :: y[:]
end
subroutine s4
projects / platform / upstream / llvm.git / commitdiff