* ALLOCATE(TYPE(derived)::...) as variant of correct ALLOCATE(derived::...) (PGI only)
* Defining an explicit interface for a subprogram within itself (PGI only)
* USE association of a procedure interface within that same procedure's definition
-* After "TYPE,EXTENDS(T1)::T2;...", the nonstandard structure constructor
- T2(T1(x)) is accepted by PGI/GNU/Intel. Use T2(T1=T1(x)) or T2(x) instead.
* NULL() as a structure constructor expression for an ALLOCATABLE component (PGI).
* Conversion of LOGICAL to INTEGER.
* IF (integer expression) THEN ... END IF (PGI/Intel)
* Procedure pointers in COMMON blocks (PGI/Intel)
* Underindexing multi-dimensional arrays (e.g., A(1) rather than A(1,1)) (PGI only)
* Legacy PGI `NCHARACTER` type and `NC` Kanji character literals
+* Using non-integer expressions for array bounds (e.g., A(3.14159)) (PGI/Intel)
u);
}
-Expr<SubscriptInteger> ProcedureRef::LEN() const {
+std::optional<Expr<SubscriptInteger>> ProcedureRef::LEN() const {
if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&proc_.u)}) {
if (intrinsic->name == "repeat") {
// LEN(REPEAT(ch,n)) == LEN(ch) * n
const auto *nCopiesArg{
UnwrapExpr<Expr<SomeInteger>>(arguments_[1].value())};
CHECK(stringArg != nullptr && nCopiesArg != nullptr);
- auto stringLen{stringArg->LEN()};
- return std::move(stringLen) *
- ConvertTo(stringLen, common::Clone(*nCopiesArg));
- }
- if (intrinsic->name == "trim") {
- // LEN(TRIM(ch)) is unknown without execution.
- CHECK(arguments_.size() == 1);
- const auto *stringArg{
- UnwrapExpr<Expr<SomeCharacter>>(arguments_[0].value())};
- CHECK(stringArg != nullptr);
- return stringArg->LEN();
+ if (auto stringLen{stringArg->LEN()}) {
+ auto converted{ConvertTo(*stringLen, common::Clone(*nCopiesArg))};
+ return *std::move(stringLen) * std::move(converted);
+ }
}
+ // Some other cases (e.g., LEN(CHAR(...))) are handled in
+ // ProcedureDesignator::LEN() because they're independent of the
+ // lengths of the actual arguments.
}
return proc_.LEN();
}
std::optional<DynamicType> GetType() const;
int Rank() const;
bool IsElemental() const;
- Expr<SubscriptInteger> LEN() const;
+ std::optional<Expr<SubscriptInteger>> LEN() const;
std::ostream &AsFortran(std::ostream &) const;
// TODO: When calling X%F, pass X as PASS argument unless NOPASS
ActualArguments &arguments() { return arguments_; }
const ActualArguments &arguments() const { return arguments_; }
- Expr<SubscriptInteger> LEN() const;
+ std::optional<Expr<SubscriptInteger>> LEN() const;
int Rank() const { return proc_.Rank(); }
bool IsElemental() const { return proc_.IsElemental(); }
bool operator==(const ProcedureRef &) const;
auto lx{ss.lower()};
Visit(lx);
ss.set_lower(std::move(lx));
- auto ux{ss.upper()};
- Visit(ux);
- ss.set_lower(std::move(ux));
+ if (auto ux{ss.upper()}) {
+ Visit(ux);
+ ss.set_upper(std::move(*ux));
+ }
}
template<typename T> void Descend(const Designator<T> &designator) {
namespace Fortran::evaluate {
template<int KIND>
-Expr<SubscriptInteger> Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
+std::optional<Expr<SubscriptInteger>>
+Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
+ using T = std::optional<Expr<SubscriptInteger>>;
return std::visit(
common::visitors{
- [](const Constant<Result> &c) {
+ [](const Constant<Result> &c) -> T {
return AsExpr(Constant<SubscriptInteger>{c.LEN()});
},
- [](const ArrayConstructor<Result> &a) { return a.LEN(); },
+ [](const ArrayConstructor<Result> &a) -> T { return a.LEN(); },
[](const Parentheses<Result> &x) { return x.left().LEN(); },
[](const Convert<Result> &x) {
return std::visit(
[&](const auto &kx) { return kx.LEN(); }, x.left().u);
},
- [](const Concat<KIND> &c) {
- return c.left().LEN() + c.right().LEN();
+ [](const Concat<KIND> &c) -> T {
+ if (auto llen{c.left().LEN()}) {
+ if (auto rlen{c.right().LEN()}) {
+ return *std::move(llen) + *std::move(rlen);
+ }
+ }
+ return std::nullopt;
},
- [](const Extremum<Result> &c) {
- return Expr<SubscriptInteger>{
- Extremum<SubscriptInteger>{c.left().LEN(), c.right().LEN()}};
+ [](const Extremum<Result> &c) -> T {
+ if (auto llen{c.left().LEN()}) {
+ if (auto rlen{c.right().LEN()}) {
+ return Expr<SubscriptInteger>{Extremum<SubscriptInteger>{
+ *std::move(llen), *std::move(rlen)}};
+ }
+ }
+ return std::nullopt;
},
[](const Designator<Result> &dr) { return dr.LEN(); },
[](const FunctionRef<Result> &fr) { return fr.LEN(); },
- [](const SetLength<KIND> &x) { return x.right(); },
+ [](const SetLength<KIND> &x) -> T { return x.right(); },
},
u);
}
u);
}
-Expr<SubscriptInteger> Expr<SomeCharacter>::LEN() const {
+std::optional<Expr<SubscriptInteger>> Expr<SomeCharacter>::LEN() const {
return std::visit([](const auto &kx) { return kx.LEN(); }, u);
}
ArrayConstructor(Expr<SubscriptInteger> &&len, Base &&v)
: Base{std::move(v)}, length_{std::move(len)} {}
template<typename A>
- explicit ArrayConstructor(const A &prototype) : length_{prototype.LEN()} {}
+ explicit ArrayConstructor(const A &prototype)
+ : length_{prototype.LEN().value()} {}
bool operator==(const ArrayConstructor &) const;
static constexpr Result result() { return Result{}; }
static constexpr DynamicType GetType() { return Result::GetType(); }
explicit Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
explicit Expr(Scalar<Result> &&x) : u{Constant<Result>{std::move(x)}} {}
- Expr<SubscriptInteger> LEN() const;
+ std::optional<Expr<SubscriptInteger>> LEN() const;
std::variant<Constant<Result>, ArrayConstructor<Result>, Designator<Result>,
FunctionRef<Result>, Parentheses<Result>, Convert<Result>, Concat<KIND>,
using Result = SomeCharacter;
EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
int GetKind() const;
- Expr<SubscriptInteger> LEN() const;
+ std::optional<Expr<SubscriptInteger>> LEN() const;
common::MapTemplate<Expr, CategoryTypes<TypeCategory::Character>> u;
};
} else if (name == "len") {
if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
return std::visit(
- [&](auto &kx) { return Fold(context, ConvertToType<T>(kx.LEN())); },
+ [&](auto &kx) {
+ if (auto len{kx.LEN()}) {
+ return Fold(context, ConvertToType<T>(*std::move(len)));
+ } else {
+ return Expr<T>{std::move(funcRef)};
+ }
+ },
charExpr->u);
} else {
common::die("len() argument must be of character type");
{{"idnint", {{"a", DoublePrecision}}, DefaultInt}, "nint"},
{{"ifix", {{"a", DefaultReal}}, DefaultInt}, "int", true},
{{"index", {{"string", DefaultChar}, {"substring", DefaultChar}},
- DefaultInt}},
+ SubscriptInt}},
{{"isign", {{"a", DefaultInt}, {"b", DefaultInt}}, DefaultInt}, "sign"},
- {{"len", {{"string", DefaultChar, Rank::anyOrAssumedRank}}, DefaultInt,
+ {{"len", {{"string", DefaultChar, Rank::anyOrAssumedRank}}, SubscriptInt,
Rank::scalar}},
{{"lge", {{"string_a", DefaultChar}, {"string_b", DefaultChar}},
DefaultLogical}},
return *this;
}
-Expr<SubscriptInteger> Substring::upper() const {
+std::optional<Expr<SubscriptInteger>> Substring::upper() const {
if (upper_.has_value()) {
return upper_.value().value();
} else {
return std::visit(
common::visitors{
[](const DataRef &dataRef) { return dataRef.LEN(); },
- [](const StaticDataObject::Pointer &object) {
+ [](const StaticDataObject::Pointer &object)
+ -> std::optional<Expr<SubscriptInteger>> {
return AsExpr(Constant<SubscriptInteger>{object->data().size()});
},
},
}
// LEN()
-static Expr<SubscriptInteger> SymbolLEN(const Symbol &sym) {
- return AsExpr(Constant<SubscriptInteger>{0}); // TODO
+static std::optional<Expr<SubscriptInteger>> SymbolLEN(const Symbol &sym) {
+ if (auto dyType{DynamicType::From(sym)}) {
+ if (const semantics::ParamValue * len{dyType->charLength()}) {
+ if (auto intExpr{len->GetExplicit()}) {
+ return ConvertToType<SubscriptInteger>(*std::move(intExpr));
+ }
+ }
+ }
+ return std::nullopt;
}
-Expr<SubscriptInteger> BaseObject::LEN() const {
+std::optional<Expr<SubscriptInteger>> BaseObject::LEN() const {
return std::visit(
common::visitors{
[](const Symbol *symbol) { return SymbolLEN(*symbol); },
- [](const StaticDataObject::Pointer &object) {
+ [](const StaticDataObject::Pointer &object)
+ -> std::optional<Expr<SubscriptInteger>> {
return AsExpr(Constant<SubscriptInteger>{object->data().size()});
},
},
u);
}
-Expr<SubscriptInteger> Component::LEN() const {
+std::optional<Expr<SubscriptInteger>> Component::LEN() const {
return SymbolLEN(GetLastSymbol());
}
-Expr<SubscriptInteger> NamedEntity::LEN() const {
+std::optional<Expr<SubscriptInteger>> NamedEntity::LEN() const {
return SymbolLEN(GetLastSymbol());
}
-Expr<SubscriptInteger> ArrayRef::LEN() const { return base_.LEN(); }
+std::optional<Expr<SubscriptInteger>> ArrayRef::LEN() const {
+ return base_.LEN();
+}
-Expr<SubscriptInteger> CoarrayRef::LEN() const {
+std::optional<Expr<SubscriptInteger>> CoarrayRef::LEN() const {
return SymbolLEN(GetLastSymbol());
}
-Expr<SubscriptInteger> DataRef::LEN() const {
+std::optional<Expr<SubscriptInteger>> DataRef::LEN() const {
return std::visit(
common::visitors{
[](const Symbol *s) { return SymbolLEN(*s); },
u);
}
-Expr<SubscriptInteger> Substring::LEN() const {
- return AsExpr(
- Extremum<SubscriptInteger>{AsExpr(Constant<SubscriptInteger>{0}),
- upper() - lower() + AsExpr(Constant<SubscriptInteger>{1})});
+std::optional<Expr<SubscriptInteger>> Substring::LEN() const {
+ if (auto top{upper()}) {
+ return AsExpr(
+ Extremum<SubscriptInteger>{AsExpr(Constant<SubscriptInteger>{0}),
+ *std::move(top) - lower() + AsExpr(Constant<SubscriptInteger>{1})});
+ } else {
+ return std::nullopt;
+ }
}
-template<typename T> Expr<SubscriptInteger> Designator<T>::LEN() const {
- if constexpr (Result::category == TypeCategory::Character) {
+template<typename T>
+std::optional<Expr<SubscriptInteger>> Designator<T>::LEN() const {
+ if constexpr (T::category == TypeCategory::Character) {
return std::visit(
common::visitors{
[](const Symbol *s) { return SymbolLEN(*s); },
- [](const Component &c) { return c.LEN(); },
[](const auto &x) { return x.LEN(); },
},
u);
} else {
- CHECK(!"LEN() on non-character Designator");
- return AsExpr(Constant<SubscriptInteger>{0});
+ common::die("Designator<non-char>::LEN() called");
+ return std::nullopt;
}
}
-Expr<SubscriptInteger> ProcedureDesignator::LEN() const {
- // TODO: this needs more thought for assumed-length
- // character functions, intrinsics, &c.
+std::optional<Expr<SubscriptInteger>> ProcedureDesignator::LEN() const {
+ using T = std::optional<Expr<SubscriptInteger>>;
return std::visit(
common::visitors{
- [](const Symbol *s) { return SymbolLEN(*s); },
- [](const common::CopyableIndirection<Component> &c) {
+ [](const Symbol *s) -> T { return SymbolLEN(*s); },
+ [](const common::CopyableIndirection<Component> &c) -> T {
return c.value().LEN();
},
- [](const auto &) {
- // TODO: intrinsics
- CRASH_NO_CASE;
- return AsExpr(Constant<SubscriptInteger>{0});
+ [](const SpecificIntrinsic &i) -> T {
+ if (i.name == "char") {
+ return Expr<SubscriptInteger>{1};
+ }
+ // Some other cases whose results' lengths can be determined
+ // from the lengths of their arguments are handled in
+ // ProcedureRef::LEN().
+ return std::nullopt;
},
},
u);
explicit BaseObject(const Symbol &symbol) : u{&symbol} {}
explicit BaseObject(StaticDataObject::Pointer &&p) : u{std::move(p)} {}
int Rank() const;
- Expr<SubscriptInteger> LEN() const;
+ std::optional<Expr<SubscriptInteger>> LEN() const;
bool operator==(const BaseObject &) const;
std::ostream &AsFortran(std::ostream &) const;
const Symbol *symbol() const {
int Rank() const;
const Symbol &GetFirstSymbol() const;
const Symbol &GetLastSymbol() const { return *symbol_; }
- Expr<SubscriptInteger> LEN() const;
+ std::optional<Expr<SubscriptInteger>> LEN() const;
bool operator==(const Component &) const;
std::ostream &AsFortran(std::ostream &) const;
Component *UnwrapComponent();
int Rank() const;
- Expr<SubscriptInteger> LEN() const;
+ std::optional<Expr<SubscriptInteger>> LEN() const;
bool operator==(const NamedEntity &) const;
std::ostream &AsFortran(std::ostream &) const;
int Rank() const;
const Symbol &GetFirstSymbol() const;
const Symbol &GetLastSymbol() const;
- Expr<SubscriptInteger> LEN() const;
+ std::optional<Expr<SubscriptInteger>> LEN() const;
bool operator==(const ArrayRef &) const;
std::ostream &AsFortran(std::ostream &) const;
const Symbol &GetFirstSymbol() const;
const Symbol &GetLastSymbol() const;
NamedEntity GetBase() const;
- Expr<SubscriptInteger> LEN() const;
+ std::optional<Expr<SubscriptInteger>> LEN() const;
bool operator==(const CoarrayRef &) const;
std::ostream &AsFortran(std::ostream &) const;
int Rank() const;
const Symbol &GetFirstSymbol() const;
const Symbol &GetLastSymbol() const;
- Expr<SubscriptInteger> LEN() const;
+ std::optional<Expr<SubscriptInteger>> LEN() const;
std::ostream &AsFortran(std::ostream &) const;
std::variant<const Symbol *, Component, ArrayRef, CoarrayRef> u;
Expr<SubscriptInteger> lower() const;
Substring &set_lower(Expr<SubscriptInteger> &&);
- Expr<SubscriptInteger> upper() const;
+ std::optional<Expr<SubscriptInteger>> upper() const;
Substring &set_upper(Expr<SubscriptInteger> &&);
const Parent &parent() const { return parent_; }
Parent &parent() { return parent_; }
}
BaseObject GetBaseObject() const;
const Symbol *GetLastSymbol() const;
- Expr<SubscriptInteger> LEN() const;
+ std::optional<Expr<SubscriptInteger>> LEN() const;
bool operator==(const Substring &) const;
std::ostream &AsFortran(std::ostream &) const;
int Rank() const;
BaseObject GetBaseObject() const;
const Symbol *GetLastSymbol() const;
- Expr<SubscriptInteger> LEN() const;
+ std::optional<Expr<SubscriptInteger>> LEN() const;
std::ostream &AsFortran(std::ostream &o) const;
Variant u;
GetSubstringBound(std::get<1>(range.t))};
if (MaybeExpr string{Analyze(std::get<parser::CharLiteralConstant>(x.t))}) {
if (auto *charExpr{std::get_if<Expr<SomeCharacter>>(&string->u)}) {
- Expr<SubscriptInteger> length{std::visit(
- [](const auto &ckExpr) { return ckExpr.LEN(); }, charExpr->u)};
+ Expr<SubscriptInteger> length{
+ std::visit([](const auto &ckExpr) { return ckExpr.LEN().value(); },
+ charExpr->u)};
if (!lower.has_value()) {
lower = Expr<SubscriptInteger>{1};
}
type.GetDerivedTypeSpec(), MakeSpecific<T>(std::move(values))});
} else if (type.kind() == T::kind) {
if constexpr (T::category == TypeCategory::Character) {
- return AsMaybeExpr(ArrayConstructor<T>{
- type.LEN().value(), MakeSpecific<T>(std::move(values))});
+ if (auto len{type.LEN()}) {
+ return AsMaybeExpr(ArrayConstructor<T>{
+ *std::move(len), MakeSpecific<T>(std::move(values))});
+ }
} else {
return AsMaybeExpr(
ArrayConstructor<T>{MakeSpecific<T>(std::move(values))});
void CheckRef(const std::optional<parser::Name> &);
const DeclTypeSpec &ToDeclTypeSpec(evaluate::DynamicType &&);
const DeclTypeSpec &ToDeclTypeSpec(
- evaluate::DynamicType &&, SubscriptIntExpr &&length);
+ evaluate::DynamicType &&, MaybeSubscriptIntExpr &&length);
Symbol *MakeAssocEntity();
void SetTypeFromAssociation(Symbol &);
void SetAttrsFromAssociation(Symbol &);
}
const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
- evaluate::DynamicType &&type, SubscriptIntExpr &&length) {
+ evaluate::DynamicType &&type, MaybeSubscriptIntExpr &&length) {
CHECK(type.category() == common::TypeCategory::Character);
- return currScope().MakeCharacterType(
- ParamValue{SomeIntExpr{std::move(length)}}, KindExpr{type.kind()});
+ if (length.has_value()) {
+ return currScope().MakeCharacterType(
+ ParamValue{SomeIntExpr{*std::move(length)}}, KindExpr{type.kind()});
+ } else {
+ return currScope().MakeCharacterType(
+ ParamValue::Deferred(), KindExpr{type.kind()});
+ }
}
// ResolveNamesVisitor implementation
print *, "z:", z
end associate
!TODO: need correct length for z
- !DEF: /s2/Block2/z AssocEntity CHARACTER(0_8,1)
+ !DEF: /s2/Block2/z AssocEntity CHARACTER(8_8,1)
!REF: /s2/x
!REF: /s2/y
associate (z => x//y)