From 3edc423bf82ee83d049fc224da847471dc8412db Mon Sep 17 00:00:00 2001 From: peter klausler Date: Wed, 27 Feb 2019 15:51:03 -0800 Subject: [PATCH] [flang] Add SetLength operator to make character length changes explicit Original-commit: flang-compiler/f18@f2d751d8a6c1bf31f69031bbdab0a823999ebf5c Reviewed-on: https://github.com/flang-compiler/f18/pull/311 Tree-same-pre-rewrite: false --- flang/lib/evaluate/expression.cc | 1 + flang/lib/evaluate/expression.h | 18 +++++++++++++++++- flang/lib/evaluate/tools.cc | 19 +++++++++++++++++-- flang/lib/evaluate/type.cc | 28 +++++++++++++--------------- flang/lib/semantics/expression.cc | 3 ++- flang/test/semantics/structconst02.f90 | 3 +++ 6 files changed, 53 insertions(+), 19 deletions(-) diff --git a/flang/lib/evaluate/expression.cc b/flang/lib/evaluate/expression.cc index 5146c72..4725162 100644 --- a/flang/lib/evaluate/expression.cc +++ b/flang/lib/evaluate/expression.cc @@ -177,6 +177,7 @@ Expr Expr>::LEN() const { }, [](const Designator &dr) { return dr.LEN(); }, [](const FunctionRef &fr) { return fr.LEN(); }, + [](const SetLength &x) { return x.right(); }, }, u); } diff --git a/flang/lib/evaluate/expression.h b/flang/lib/evaluate/expression.h index 8271a65..9367766 100644 --- a/flang/lib/evaluate/expression.h +++ b/flang/lib/evaluate/expression.h @@ -272,6 +272,22 @@ struct Not : public Operation, Type, static std::ostream &Prefix(std::ostream &o) { return o << "(.NOT."; } }; +// Character lengths are determined by context in Fortran and do not +// have explicit syntax for changing them. Expressions represent +// changes of length (e.g., for assignments and structure constructors) +// with this operation. +template +struct SetLength + : public Operation, Type, + Type, SubscriptInteger> { + using Result = Type; + using CharacterOperand = Result; + using LengthOperand = SubscriptInteger; + using Base = Operation; + using Base::Base; + static std::ostream &Prefix(std::ostream &o) { return o << "%SET_LENGTH("; } +}; + // Binary operations template struct Add : public Operation, A, A, A> { @@ -569,7 +585,7 @@ public: std::variant, ArrayConstructor, Designator, FunctionRef, Parentheses, Convert, Concat, - Extremum> + Extremum, SetLength> u; }; diff --git a/flang/lib/evaluate/tools.cc b/flang/lib/evaluate/tools.cc index 6a16deb..d4a29dd 100644 --- a/flang/lib/evaluate/tools.cc +++ b/flang/lib/evaluate/tools.cc @@ -528,8 +528,24 @@ std::optional> ConvertToType( return ConvertToNumeric(type.kind, std::move(x)); case TypeCategory::Character: if (auto *cx{UnwrapExpr>(x)}) { - return Expr{ + auto converted{ ConvertToKind(type.kind, std::move(*cx))}; + if (type.charLength != nullptr) { + 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)); + } + } + return Expr{std::move(converted)}; } break; case TypeCategory::Logical: @@ -558,7 +574,6 @@ std::optional> ConvertToType( } } if (auto symType{GetSymbolType(symbol)}) { - // TODO pmk CHARACTER length return ConvertToType(*symType, std::move(x)); } return std::nullopt; diff --git a/flang/lib/evaluate/type.cc b/flang/lib/evaluate/type.cc index 6e92cfc..252aad8 100644 --- a/flang/lib/evaluate/type.cc +++ b/flang/lib/evaluate/type.cc @@ -99,24 +99,22 @@ bool DynamicType::operator==(const DynamicType &that) const { PointeeComparison(derived, that.derived); } -std::optional GetSymbolType(const semantics::Symbol *symbol) { - if (symbol != nullptr) { - if (const auto *type{symbol->GetType()}) { - if (const auto *intrinsic{type->AsIntrinsic()}) { - if (auto kind{ToInt64(intrinsic->kind())}) { - TypeCategory category{intrinsic->category()}; - if (IsValidKindOfIntrinsicType(category, *kind)) { - if (category == TypeCategory::Character) { - const auto &charType{type->characterTypeSpec()}; - return DynamicType{static_cast(*kind), charType.length()}; - } else { - return DynamicType{category, static_cast(*kind)}; - } +std::optional GetSymbolType(const semantics::Symbol &symbol) { + if (const auto *type{symbol.GetType()}) { + if (const auto *intrinsic{type->AsIntrinsic()}) { + if (auto kind{ToInt64(intrinsic->kind())}) { + TypeCategory category{intrinsic->category()}; + if (IsValidKindOfIntrinsicType(category, *kind)) { + if (category == TypeCategory::Character) { + const auto &charType{type->characterTypeSpec()}; + return DynamicType{static_cast(*kind), charType.length()}; + } else { + return DynamicType{category, static_cast(*kind)}; } } - } else if (const auto *derived{type->AsDerived()}) { - return DynamicType{*derived}; } + } else if (const auto *derived{type->AsDerived()}) { + return DynamicType{*derived}; } } return std::nullopt; diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 72eaa61..c970416 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -1496,7 +1496,8 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context, result.Add(*symbol, std::move(*converted)); } else { if (auto *msg{context.Say(expr.source, - "Structure constructor value is incompatible with component"_err_en_US)}) { + "Structure constructor value is incompatible with component '%s'"_err_en_US, + symbol->name().ToString().data())}) { msg->Attach(symbol->name(), "Component declaration"_en_US); } } diff --git a/flang/test/semantics/structconst02.f90 b/flang/test/semantics/structconst02.f90 index a50fa0f..71ffc98 100644 --- a/flang/test/semantics/structconst02.f90 +++ b/flang/test/semantics/structconst02.f90 @@ -44,8 +44,11 @@ module module1 ! call scalararg(scalar(4)(5.,6,(7._8,8._2),4_'b',.true._4)) call scalararg(scalar(4)(ix=5.,rx=6,zx=(7._8,8._2),cx=4_'b',lx=.true.)) call scalararg(scalar(4)(5.,6,(7._8,8._2),4_'b',.true.)) + !ERROR: Structure constructor value is incompatible with component 'ix' call scalararg(scalar(4)(ix='a')) + !ERROR: Structure constructor value is incompatible with component 'ix' call scalararg(scalar(4)(ix=.false.)) + !ERROR: Structure constructor value is incompatible with component 'ix' call scalararg(scalar(4)(ix=[1])) !TODO more! end subroutine errors -- 2.7.4