From ac9641753bba836f2c22e0a2366b5233788d50b3 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Wed, 2 Jun 2021 17:13:55 -0700 Subject: [PATCH] [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 --- flang/include/flang/Evaluate/fold.h | 5 ++-- flang/include/flang/Evaluate/type.h | 19 +++++++++------ flang/lib/Evaluate/characteristics.cpp | 12 ++++------ flang/lib/Evaluate/formatting.cpp | 10 ++++---- flang/lib/Evaluate/intrinsics.cpp | 20 +++++++++------- flang/lib/Evaluate/tools.cpp | 24 ++++++++----------- flang/lib/Evaluate/type.cpp | 36 +++++++++++++++++++++------- flang/lib/Evaluate/variable.cpp | 31 +++++++++++------------- flang/lib/Semantics/expression.cpp | 16 ++++--------- flang/lib/Semantics/scope.cpp | 2 +- flang/test/Semantics/array-constr-values.f90 | 6 +++++ flang/test/Semantics/data02.f90 | 2 +- flang/test/Semantics/separate-mp02.f90 | 4 ++-- 13 files changed, 104 insertions(+), 83 deletions(-) diff --git a/flang/include/flang/Evaluate/fold.h b/flang/include/flang/Evaluate/fold.h index 3a2258d..e7081a0 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, EXPR> * { // GetScalarConstantValue() extracts the known scalar constant value of // an expression, if it has one. The value can be parenthesized. template -auto GetScalarConstantValue(const EXPR &expr) -> std::optional> { +constexpr auto GetScalarConstantValue(const EXPR &expr) + -> std::optional> { if (const Constant *constant{UnwrapConstantValue(expr)}) { return constant->GetScalarValue(); } else { @@ -81,7 +82,7 @@ auto GetScalarConstantValue(const EXPR &expr) -> std::optional> { // Ensure that the expression has been folded beforehand when folding might // be required. template -std::optional ToInt64( +constexpr std::optional ToInt64( const Expr> &expr) { if (auto scalar{ GetScalarConstantValue>(expr)}) { diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h index f2d84b6..124fb39 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 @@ public: CHECK(kind_ > 0); return kind_; } - constexpr const semantics::ParamValue *charLength() const { - return charLength_; + constexpr const semantics::ParamValue *charLengthParamValue() const { + return charLengthParamValue_; + } + constexpr std::optional knownLength() const { + return knownLength_; } std::optional> GetCharLength() const; @@ -212,7 +216,8 @@ private: TypeCategory category_{TypeCategory::Derived}; // overridable default int kind_{0}; - const semantics::ParamValue *charLength_{nullptr}; + const semantics::ParamValue *charLengthParamValue_{nullptr}; + std::optional 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 fc34e1b..c0824ae 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(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 f7cfaa3..25ed470 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 a068241..962ca68 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -1481,12 +1481,6 @@ std::optional 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 IntrinsicInterface::Match( CHECK(expr->Rank() == 0); if (auto code{ToInt64(*expr)}) { if (IsValidKindOfIntrinsicType(*category, *code)) { - resultType = DynamicType{*category, static_cast(*code)}; + if (*category == TypeCategory::Character) { // ACHAR & CHAR + resultType = DynamicType{static_cast(*code), 1}; + } else { + resultType = DynamicType{*category, static_cast(*code)}; + } break; } } @@ -1535,7 +1533,12 @@ std::optional 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 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 e37db52..f233ade 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -615,20 +615,16 @@ std::optional> ConvertToType( if (auto *cx{UnwrapExpr>(x)}) { auto converted{ ConvertToKind(type.kind(), std::move(*cx))}; - if (type.charLength()) { - if (const auto &len{type.charLength()->GetExplicit()}) { - Expr lenParam{*len}; - Expr length{Convert{lenParam}}; - converted = std::visit( - [&](auto &&x) { - using Ty = std::decay_t; - using CharacterType = typename Ty::Result; - return Expr{ - Expr{SetLength{ - 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; + using CharacterType = typename Ty::Result; + return Expr{ + Expr{SetLength{ + std::move(x), std::move(*length)}}}; + }, + std::move(converted.u)); } return Expr{std::move(converted)}; } diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp index 0d2004d..1c28c56 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 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> DynamicType::GetCharLength() const { - if (category_ == TypeCategory::Character && charLength_) { - if (auto length{charLength_->GetExplicit()}) { - return ConvertToType(std::move(*length)); + if (category_ == TypeCategory::Character) { + if (knownLength_) { + return AsExpr(Constant(*knownLength_)); + } else if (charLengthParamValue_) { + if (auto length{charLengthParamValue_->GetExplicit()}) { + return ConvertToType(std::move(*length)); + } } } return std::nullopt; @@ -171,16 +187,18 @@ std::optional> 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::operator==( diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp index f26b76f..2f8f887 100644 --- a/flang/lib/Evaluate/variable.cpp +++ b/flang/lib/Evaluate/variable.cpp @@ -265,18 +265,11 @@ static std::optional> 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(*std::move(intExpr)); - } - } - } - if (IsDescriptor(ultimate) && !ultimate.owner().IsDerivedType()) { - return Expr{DescriptorInquiry{ - NamedEntity{ultimate}, DescriptorInquiry::Field::Len}}; - } + if (auto len{dyType->GetCharLength()}) { + return len; + } else if (IsDescriptor(ultimate) && !ultimate.owner().IsDerivedType()) { + return Expr{DescriptorInquiry{ + NamedEntity{ultimate}, DescriptorInquiry::Field::Len}}; } } return std::nullopt; @@ -351,12 +344,16 @@ std::optional> ProcedureDesignator::LEN() const { return c.value().LEN(); }, [](const SpecificIntrinsic &i) -> T { - if (i.name == "char") { - return Expr{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 27c24e6..5a1643c 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -55,13 +55,9 @@ struct DynamicTypeWithLength : public DynamicType { std::optional> DynamicTypeWithLength::LEN() const { if (length) { return length; + } else { + return GetCharLength(); } - if (auto *lengthParam{charLength()}) { - if (const auto &len{lengthParam->GetExplicit()}) { - return ConvertToType(common::Clone(*len)); - } - } - return std::nullopt; // assumed or deferred length } static std::optional AnalyzeTypeSpec( @@ -1171,9 +1167,7 @@ public: template 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{type_->GetDerivedTypeSpec(), MakeSpecific(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(*type_) == - static_cast(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 548b55f..289146a 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 8b7883d..dee5810 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 3eacdb4..492006fe 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 5135ccf..f68ab1b 100644 --- a/flang/test/Semantics/separate-mp02.f90 +++ b/flang/test/Semantics/separate-mp02.f90 @@ -72,10 +72,10 @@ contains 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 -- 2.7.4