[flang-commits] [flang] ac96417 - [flang] Support known constant lengths in DynamicType
peter klausler via flang-commits
flang-commits at lists.llvm.org
Thu Jun 3 14:25:31 PDT 2021
Author: peter klausler
Date: 2021-06-03T14:25:22-07:00
New Revision: ac9641753bba836f2c22e0a2366b5233788d50b3
URL: https://github.com/llvm/llvm-project/commit/ac9641753bba836f2c22e0a2366b5233788d50b3
DIFF: https://github.com/llvm/llvm-project/commit/ac9641753bba836f2c22e0a2366b5233788d50b3.diff
LOG: [flang] Support known constant lengths in DynamicType
The constexpr-capable class evaluate::DynamicType represented
CHARACTER length only with a nullable pointer into the declared
parameters of types in the symbol table, which works fine for
anything with a declaration but turns out to not suffice to
describe the results of the ACHAR() and CHAR() intrinsic
functions. So extend DynamicType to also accommodate known
constant CHARACTER lengths, too; use them for ACHAR & CHAR;
clean up several use sites and fix regressions found in test.
Differential Revision: https://reviews.llvm.org/D103571
Added:
Modified:
flang/include/flang/Evaluate/fold.h
flang/include/flang/Evaluate/type.h
flang/lib/Evaluate/characteristics.cpp
flang/lib/Evaluate/formatting.cpp
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Evaluate/tools.cpp
flang/lib/Evaluate/type.cpp
flang/lib/Evaluate/variable.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/scope.cpp
flang/test/Semantics/array-constr-values.f90
flang/test/Semantics/data02.f90
flang/test/Semantics/separate-mp02.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/fold.h b/flang/include/flang/Evaluate/fold.h
index 3a2258dfc1105..e7081a06dddb2 100644
--- a/flang/include/flang/Evaluate/fold.h
+++ b/flang/include/flang/Evaluate/fold.h
@@ -69,7 +69,8 @@ auto UnwrapConstantValue(EXPR &expr) -> common::Constify<Constant<T>, EXPR> * {
// GetScalarConstantValue() extracts the known scalar constant value of
// an expression, if it has one. The value can be parenthesized.
template <typename T, typename EXPR>
-auto GetScalarConstantValue(const EXPR &expr) -> std::optional<Scalar<T>> {
+constexpr auto GetScalarConstantValue(const EXPR &expr)
+ -> std::optional<Scalar<T>> {
if (const Constant<T> *constant{UnwrapConstantValue<T>(expr)}) {
return constant->GetScalarValue();
} else {
@@ -81,7 +82,7 @@ auto GetScalarConstantValue(const EXPR &expr) -> std::optional<Scalar<T>> {
// Ensure that the expression has been folded beforehand when folding might
// be required.
template <int KIND>
-std::optional<std::int64_t> ToInt64(
+constexpr std::optional<std::int64_t> ToInt64(
const Expr<Type<TypeCategory::Integer, KIND>> &expr) {
if (auto scalar{
GetScalarConstantValue<Type<TypeCategory::Integer, KIND>>(expr)}) {
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index f2d84b6d819dd..124fb39f7fd6d 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -81,15 +81,16 @@ static constexpr bool IsValidKindOfIntrinsicType(
// directly hold anything requiring a destructor, such as an arbitrary
// CHARACTER length type parameter expression. Those must be derived
// via LEN() member functions, packaged elsewhere (e.g. as in
-// ArrayConstructor), or copied from a parameter spec in the symbol table
-// if one is supplied.
+// ArrayConstructor), copied from a parameter spec in the symbol table
+// if one is supplied, or a known integer value.
class DynamicType {
public:
constexpr DynamicType(TypeCategory cat, int k) : category_{cat}, kind_{k} {
CHECK(IsValidKindOfIntrinsicType(category_, kind_));
}
- constexpr DynamicType(int k, const semantics::ParamValue &pv)
- : category_{TypeCategory::Character}, kind_{k}, charLength_{&pv} {
+ DynamicType(int charKind, const semantics::ParamValue &len);
+ constexpr DynamicType(int k, std::int64_t len)
+ : category_{TypeCategory::Character}, kind_{k}, knownLength_{len} {
CHECK(IsValidKindOfIntrinsicType(category_, kind_));
}
explicit constexpr DynamicType(
@@ -137,8 +138,11 @@ class DynamicType {
CHECK(kind_ > 0);
return kind_;
}
- constexpr const semantics::ParamValue *charLength() const {
- return charLength_;
+ constexpr const semantics::ParamValue *charLengthParamValue() const {
+ return charLengthParamValue_;
+ }
+ constexpr std::optional<std::int64_t> knownLength() const {
+ return knownLength_;
}
std::optional<Expr<SubscriptInteger>> GetCharLength() const;
@@ -212,7 +216,8 @@ class DynamicType {
TypeCategory category_{TypeCategory::Derived}; // overridable default
int kind_{0};
- const semantics::ParamValue *charLength_{nullptr};
+ const semantics::ParamValue *charLengthParamValue_{nullptr};
+ std::optional<std::int64_t> knownLength_;
const semantics::DerivedTypeSpec *derived_{nullptr}; // TYPE(T), CLASS(T)
};
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index fc34e1b831e9c..c0824ae2f5cdc 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -216,12 +216,8 @@ void TypeAndShape::AcquireAttrs(const semantics::Symbol &symbol) {
}
void TypeAndShape::AcquireLEN() {
- if (type_.category() == TypeCategory::Character) {
- if (const auto *param{type_.charLength()}) {
- if (const auto &intExpr{param->GetExplicit()}) {
- LEN_ = ConvertToType<SubscriptInteger>(common::Clone(*intExpr));
- }
- }
+ if (auto len{type_.GetCharLength()}) {
+ LEN_ = std::move(len);
}
}
@@ -694,7 +690,9 @@ bool FunctionResult::CanBeReturnedViaImplicitInterface() const {
const DynamicType &type{typeAndShape->type()};
switch (type.category()) {
case TypeCategory::Character:
- if (const auto *param{type.charLength()}) {
+ if (type.knownLength()) {
+ return true;
+ } else if (const auto *param{type.charLengthParamValue()}) {
if (const auto &expr{param->GetExplicit()}) {
return IsConstantExpr(*expr); // 15.4.2.2(4)(c)
} else if (param->isAssumed()) {
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index f7cfaa3e6dff3..25ed470a2a92a 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -475,13 +475,15 @@ std::string DynamicType::AsFortran() const {
if (derived_) {
CHECK(category_ == TypeCategory::Derived);
return DerivedTypeSpecAsFortran(*derived_);
- } else if (charLength_) {
+ } else if (charLengthParamValue_ || knownLength_) {
std::string result{"CHARACTER(KIND="s + std::to_string(kind_) + ",LEN="};
- if (charLength_->isAssumed()) {
+ if (knownLength_) {
+ result += std::to_string(*knownLength_) + "_8";
+ } else if (charLengthParamValue_->isAssumed()) {
result += '*';
- } else if (charLength_->isDeferred()) {
+ } else if (charLengthParamValue_->isDeferred()) {
result += ':';
- } else if (const auto &length{charLength_->GetExplicit()}) {
+ } else if (const auto &length{charLengthParamValue_->GetExplicit()}) {
result += length->AsFortran();
}
return result + ')';
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index a068241a21bbd..962ca68e22319 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1481,12 +1481,6 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
CHECK(FloatingType.test(*category));
resultType = DynamicType{*category, defaults.doublePrecisionKind()};
break;
- case KindCode::defaultCharKind:
- CHECK(result.categorySet == CharType);
- CHECK(*category == TypeCategory::Character);
- resultType = DynamicType{TypeCategory::Character,
- defaults.GetDefaultKind(TypeCategory::Character)};
- break;
case KindCode::defaultLogicalKind:
CHECK(result.categorySet == LogicalType);
CHECK(*category == TypeCategory::Logical);
@@ -1516,7 +1510,11 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
CHECK(expr->Rank() == 0);
if (auto code{ToInt64(*expr)}) {
if (IsValidKindOfIntrinsicType(*category, *code)) {
- resultType = DynamicType{*category, static_cast<int>(*code)};
+ if (*category == TypeCategory::Character) { // ACHAR & CHAR
+ resultType = DynamicType{static_cast<int>(*code), 1};
+ } else {
+ resultType = DynamicType{*category, static_cast<int>(*code)};
+ }
break;
}
}
@@ -1535,7 +1533,12 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
} else {
CHECK(kindDummyArg->optionality ==
Optionality::defaultsToDefaultForResult);
- resultType = DynamicType{*category, defaults.GetDefaultKind(*category)};
+ int kind{defaults.GetDefaultKind(*category)};
+ if (*category == TypeCategory::Character) { // ACHAR & CHAR
+ resultType = DynamicType{kind, 1};
+ } else {
+ resultType = DynamicType{*category, kind};
+ }
}
break;
case KindCode::likeMultiply:
@@ -1557,6 +1560,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
resultType =
DynamicType{TypeCategory::Integer, defaults.sizeIntegerKind()};
break;
+ case KindCode::defaultCharKind:
case KindCode::typeless:
case KindCode::teamType:
case KindCode::any:
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index e37db5220b34f..f233adede1f95 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -615,20 +615,16 @@ std::optional<Expr<SomeType>> ConvertToType(
if (auto *cx{UnwrapExpr<Expr<SomeCharacter>>(x)}) {
auto converted{
ConvertToKind<TypeCategory::Character>(type.kind(), std::move(*cx))};
- if (type.charLength()) {
- if (const auto &len{type.charLength()->GetExplicit()}) {
- Expr<SomeInteger> lenParam{*len};
- Expr<SubscriptInteger> length{Convert<SubscriptInteger>{lenParam}};
- converted = std::visit(
- [&](auto &&x) {
- using Ty = std::decay_t<decltype(x)>;
- using CharacterType = typename Ty::Result;
- return Expr<SomeCharacter>{
- Expr<CharacterType>{SetLength<CharacterType::kind>{
- std::move(x), std::move(length)}}};
- },
- std::move(converted.u));
- }
+ if (auto length{type.GetCharLength()}) {
+ converted = std::visit(
+ [&](auto &&x) {
+ using Ty = std::decay_t<decltype(x)>;
+ using CharacterType = typename Ty::Result;
+ return Expr<SomeCharacter>{
+ Expr<CharacterType>{SetLength<CharacterType::kind>{
+ std::move(x), std::move(*length)}}};
+ },
+ std::move(converted.u));
}
return Expr<SomeType>{std::move(converted)};
}
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index 0d2004d12438b..1c28c56672bf6 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -92,20 +92,36 @@ bool IsDescriptor(const Symbol &symbol) {
namespace Fortran::evaluate {
+DynamicType::DynamicType(int k, const semantics::ParamValue &pv)
+ : category_{TypeCategory::Character}, kind_{k} {
+ CHECK(IsValidKindOfIntrinsicType(category_, kind_));
+ if (auto n{ToInt64(pv.GetExplicit())}) {
+ knownLength_ = *n;
+ } else {
+ charLengthParamValue_ = &pv;
+ }
+}
+
template <typename A> inline bool PointeeComparison(const A *x, const A *y) {
return x == y || (x && y && *x == *y);
}
bool DynamicType::operator==(const DynamicType &that) const {
return category_ == that.category_ && kind_ == that.kind_ &&
- PointeeComparison(charLength_, that.charLength_) &&
+ PointeeComparison(charLengthParamValue_, that.charLengthParamValue_) &&
+ knownLength_.has_value() == that.knownLength_.has_value() &&
+ (!knownLength_ || *knownLength_ == *that.knownLength_) &&
PointeeComparison(derived_, that.derived_);
}
std::optional<Expr<SubscriptInteger>> DynamicType::GetCharLength() const {
- if (category_ == TypeCategory::Character && charLength_) {
- if (auto length{charLength_->GetExplicit()}) {
- return ConvertToType<SubscriptInteger>(std::move(*length));
+ if (category_ == TypeCategory::Character) {
+ if (knownLength_) {
+ return AsExpr(Constant<SubscriptInteger>(*knownLength_));
+ } else if (charLengthParamValue_) {
+ if (auto length{charLengthParamValue_->GetExplicit()}) {
+ return ConvertToType<SubscriptInteger>(std::move(*length));
+ }
}
}
return std::nullopt;
@@ -171,16 +187,18 @@ std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
}
bool DynamicType::IsAssumedLengthCharacter() const {
- return category_ == TypeCategory::Character && charLength_ &&
- charLength_->isAssumed();
+ return category_ == TypeCategory::Character && charLengthParamValue_ &&
+ charLengthParamValue_->isAssumed();
}
bool DynamicType::IsNonConstantLengthCharacter() const {
if (category_ != TypeCategory::Character) {
return false;
- } else if (!charLength_) {
+ } else if (knownLength_) {
+ return false;
+ } else if (!charLengthParamValue_) {
return true;
- } else if (const auto &expr{charLength_->GetExplicit()}) {
+ } else if (const auto &expr{charLengthParamValue_->GetExplicit()}) {
return !IsConstantExpr(*expr);
} else {
return true;
@@ -427,7 +445,7 @@ bool DynamicType::HasDeferredTypeParameter() const {
}
}
}
- return charLength_ && charLength_->isDeferred();
+ return charLengthParamValue_ && charLengthParamValue_->isDeferred();
}
bool SomeKind<TypeCategory::Derived>::operator==(
diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index f26b76fda8595..2f8f887a59c7e 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -265,18 +265,11 @@ static std::optional<Expr<SubscriptInteger>> SymbolLEN(const Symbol &symbol) {
return chExpr->LEN();
}
} else if (auto dyType{DynamicType::From(ultimate)}) {
- if (const semantics::ParamValue * len{dyType->charLength()}) {
- if (len->isExplicit()) {
- if (auto intExpr{len->GetExplicit()}) {
- if (IsConstantExpr(*intExpr)) {
- return ConvertToType<SubscriptInteger>(*std::move(intExpr));
- }
- }
- }
- if (IsDescriptor(ultimate) && !ultimate.owner().IsDerivedType()) {
- return Expr<SubscriptInteger>{DescriptorInquiry{
- NamedEntity{ultimate}, DescriptorInquiry::Field::Len}};
- }
+ if (auto len{dyType->GetCharLength()}) {
+ return len;
+ } else if (IsDescriptor(ultimate) && !ultimate.owner().IsDerivedType()) {
+ return Expr<SubscriptInteger>{DescriptorInquiry{
+ NamedEntity{ultimate}, DescriptorInquiry::Field::Len}};
}
}
return std::nullopt;
@@ -351,12 +344,16 @@ std::optional<Expr<SubscriptInteger>> ProcedureDesignator::LEN() const {
return c.value().LEN();
},
[](const SpecificIntrinsic &i) -> T {
- if (i.name == "char") {
- return Expr<SubscriptInteger>{1};
- }
- // Some other cases whose results' lengths can be determined
+ // Some cases whose results' lengths can be determined
// from the lengths of their arguments are handled in
- // ProcedureRef::LEN().
+ // ProcedureRef::LEN() before coming here.
+ if (const auto &result{i.characteristics.value().functionResult}) {
+ if (const auto *type{result->GetTypeAndShape()}) {
+ if (auto length{type->type().GetCharLength()}) {
+ return std::move(*length);
+ }
+ }
+ }
return std::nullopt;
},
},
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 27c24e6b26559..5a1643cc8aa33 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -55,13 +55,9 @@ struct DynamicTypeWithLength : public DynamicType {
std::optional<Expr<SubscriptInteger>> DynamicTypeWithLength::LEN() const {
if (length) {
return length;
+ } else {
+ return GetCharLength();
}
- if (auto *lengthParam{charLength()}) {
- if (const auto &len{lengthParam->GetExplicit()}) {
- return ConvertToType<SubscriptInteger>(common::Clone(*len));
- }
- }
- return std::nullopt; // assumed or deferred length
}
static std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
@@ -1171,9 +1167,7 @@ class ArrayConstructorContext {
template <typename T> Result Test() {
if (type_ && type_->category() == T::category) {
if constexpr (T::category == TypeCategory::Derived) {
- if (type_->IsUnlimitedPolymorphic()) {
- return std::nullopt;
- } else {
+ if (!type_->IsUnlimitedPolymorphic()) {
return AsMaybeExpr(ArrayConstructor<T>{type_->GetDerivedTypeSpec(),
MakeSpecific<T>(std::move(values_))});
}
@@ -1262,8 +1256,8 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
constantLength_ = ToInt64(type_->length);
values_.Push(std::move(*x));
} else if (!explicitType_) {
- if (static_cast<const DynamicType &>(*type_) ==
- static_cast<const DynamicType &>(xType)) {
+ if (type_->IsTkCompatibleWith(xType) &&
+ xType.IsTkCompatibleWith(*type_)) {
values_.Push(std::move(*x));
if (auto thisLen{ToInt64(xType.LEN())}) {
if (constantLength_) {
diff --git a/flang/lib/Semantics/scope.cpp b/flang/lib/Semantics/scope.cpp
index 548b55fd8f0df..289146a95efc7 100644
--- a/flang/lib/Semantics/scope.cpp
+++ b/flang/lib/Semantics/scope.cpp
@@ -215,7 +215,7 @@ const DeclTypeSpec *Scope::GetType(const SomeExpr &expr) {
case TypeCategory::Complex:
return &MakeNumericType(dyType->category(), KindExpr{dyType->kind()});
case TypeCategory::Character:
- if (const ParamValue * lenParam{dyType->charLength()}) {
+ if (const ParamValue * lenParam{dyType->charLengthParamValue()}) {
return &MakeCharacterType(
ParamValue{*lenParam}, KindExpr{dyType->kind()});
} else {
diff --git a/flang/test/Semantics/array-constr-values.f90 b/flang/test/Semantics/array-constr-values.f90
index 8b7883d213a66..dee5810588ed5 100644
--- a/flang/test/Semantics/array-constr-values.f90
+++ b/flang/test/Semantics/array-constr-values.f90
@@ -83,3 +83,9 @@ subroutine checkOkDuplicates
(0.0, iDuplicate = j,3 ), &
j = 1,5 ) ]
end subroutine
+subroutine charLengths(c, array)
+ character(3) :: c
+ character(3) :: array(2)
+ !No error should ensue for distinct but compatible DynamicTypes
+ array = ["abc", c]
+end subroutine
diff --git a/flang/test/Semantics/data02.f90 b/flang/test/Semantics/data02.f90
index 3eacdb49b8770..492006fe2f430 100644
--- a/flang/test/Semantics/data02.f90
+++ b/flang/test/Semantics/data02.f90
@@ -6,7 +6,7 @@ subroutine s1
character(1) :: c
end type
type(t) :: x
- !ERROR: Value in structure constructor of type INTEGER(4) is incompatible with component 'c' of type CHARACTER(KIND=1,LEN=1_4)
+ !ERROR: Value in structure constructor of type INTEGER(4) is incompatible with component 'c' of type CHARACTER(KIND=1,LEN=1_8)
data x /t(1)/
end
diff --git a/flang/test/Semantics/separate-mp02.f90 b/flang/test/Semantics/separate-mp02.f90
index 5135ccf734f91..f68ab1bb6e7d5 100644
--- a/flang/test/Semantics/separate-mp02.f90
+++ b/flang/test/Semantics/separate-mp02.f90
@@ -72,10 +72,10 @@ module subroutine s8(x, y, z)
end
module subroutine s9(x, y, z, w)
character(len=4) :: x
- !ERROR: Dummy argument 'y' has type CHARACTER(KIND=1,LEN=5_4); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=4_4)
+ !ERROR: Dummy argument 'y' has type CHARACTER(KIND=1,LEN=5_8); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=4_8)
character(len=5) :: y
character(len=*) :: z
- !ERROR: Dummy argument 'w' has type CHARACTER(KIND=1,LEN=4_4); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=*)
+ !ERROR: Dummy argument 'w' has type CHARACTER(KIND=1,LEN=4_8); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=*)
character(len=4) :: w
end
end
More information about the flang-commits
mailing list