maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[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
This commit is contained in:
peter klausler 2021-06-02 17:13:55 -07:00
parent d0ee8b64ec
commit ac9641753b
13 changed files with 104 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
flang/include/flang/Evaluate/fold.h
View File

@ -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)}) {

19
flang/include/flang/Evaluate/type.h
View File

@ -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<std::int64_t> knownLength() const {
return knownLength_;
}
std::optional<Expr<SubscriptInteger>> 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<std::int64_t> knownLength_;
const semantics::DerivedTypeSpec *derived_{nullptr}; // TYPE(T), CLASS(T)
};

12
flang/lib/Evaluate/characteristics.cpp
View File

@ -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()) {

10
flang/lib/Evaluate/formatting.cpp
View File

@ -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 + ')';

20
flang/lib/Evaluate/intrinsics.cpp
View File

@ -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:

24
flang/lib/Evaluate/tools.cpp
View File

@ -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)};
}

36
flang/lib/Evaluate/type.cpp
View File

@ -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==(

31
flang/lib/Evaluate/variable.cpp
View File

@ -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;
},
},

16
flang/lib/Semantics/expression.cpp
View File

@ -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 @@ public:
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_) {

2
flang/lib/Semantics/scope.cpp
View File

@ -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 {

6
flang/test/Semantics/array-constr-values.f90
View File

@ -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

2
flang/test/Semantics/data02.f90
View File

@ -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

4
flang/test/Semantics/separate-mp02.f90
View File

@ -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