forked from OSchip/llvm-project
[flang] Extension: initialization of LOGICAL with INTEGER & vice versa
We already accept assignments of INTEGER to LOGICAL (& vice versa) as an extension, but not initialization. Extend initialization to cover those cases. (Also fix misspelling in nearby comment as suggested by code reviewer.) Decouple an inadvertent dependence cycle by moving two one-line function definitions into a header file. Differential Revision: https://reviews.llvm.org/D117159
This commit is contained in:
parent
cb6b9d3ae2
commit
00e0de0572
|
@ -165,6 +165,10 @@ end
|
|||
hold true for definable arguments.
|
||||
* Assignment of `LOGICAL` to `INTEGER` and vice versa (but not other types) is
|
||||
allowed. The values are normalized.
|
||||
* Static initialization of `LOGICAL` with `INTEGER` is allowed in `DATA` statements
|
||||
and object initializers.
|
||||
The results are *not* normalized to canonical `.TRUE.`/`.FALSE.`.
|
||||
Static initialization of `INTEGER` with `LOGICAL` is also permitted.
|
||||
* An effectively empty source file (no program unit) is accepted and
|
||||
produces an empty relocatable output file.
|
||||
* A `RETURN` statement may appear in a main program.
|
||||
|
|
|
@ -17,6 +17,7 @@ namespace Fortran::evaluate::value {
|
|||
template <int BITS, bool IS_LIKE_C = true> class Logical {
|
||||
public:
|
||||
static constexpr int bits{BITS};
|
||||
using Word = Integer<bits>;
|
||||
|
||||
// Module ISO_C_BINDING kind C_BOOL is LOGICAL(KIND=1) and must have
|
||||
// C's bit representation (.TRUE. -> 1, .FALSE. -> 0).
|
||||
|
@ -26,12 +27,19 @@ public:
|
|||
template <int B, bool C>
|
||||
constexpr Logical(Logical<B, C> x) : word_{Represent(x.IsTrue())} {}
|
||||
constexpr Logical(bool truth) : word_{Represent(truth)} {}
|
||||
// A raw word, for DATA initialization
|
||||
constexpr Logical(Word &&w) : word_{std::move(w)} {}
|
||||
|
||||
template <int B, bool C> constexpr Logical &operator=(Logical<B, C> x) {
|
||||
word_ = Represent(x.IsTrue());
|
||||
return *this;
|
||||
}
|
||||
|
||||
Word word() const { return word_; }
|
||||
bool IsCanonical() const {
|
||||
return word_ == canonicalFalse || word_ == canonicalTrue;
|
||||
}
|
||||
|
||||
// Fortran actually has only .EQV. & .NEQV. relational operations
|
||||
// for LOGICAL, but this template class supports more so that
|
||||
// it can be used with the STL for sorting and as a key type for
|
||||
|
@ -86,13 +94,11 @@ public:
|
|||
}
|
||||
|
||||
private:
|
||||
using Word = Integer<bits>;
|
||||
static constexpr Word canonicalTrue{IsLikeC ? -std::uint64_t{1} : 1};
|
||||
static constexpr Word canonicalTrue{IsLikeC ? 1 : -std::uint64_t{1}};
|
||||
static constexpr Word canonicalFalse{0};
|
||||
static constexpr Word Represent(bool x) {
|
||||
return x ? canonicalTrue : canonicalFalse;
|
||||
}
|
||||
constexpr Logical(const Word &w) : word_{w} {}
|
||||
Word word_;
|
||||
};
|
||||
|
||||
|
|
|
@ -1030,6 +1030,11 @@ Constant<T> PackageConstant(std::vector<Scalar<T>> &&elements,
|
|||
}
|
||||
}
|
||||
|
||||
// Nonstandard conversions of constants (integer->logical, logical->integer)
|
||||
// that can appear in DATA statements as an extension.
|
||||
std::optional<Expr<SomeType>> DataConstantConversionExtension(
|
||||
FoldingContext &, const DynamicType &, const Expr<SomeType> &);
|
||||
|
||||
} // namespace Fortran::evaluate
|
||||
|
||||
namespace Fortran::semantics {
|
||||
|
|
|
@ -75,8 +75,12 @@ public:
|
|||
return defaultKinds_.doublePrecisionKind();
|
||||
}
|
||||
int quadPrecisionKind() const { return defaultKinds_.quadPrecisionKind(); }
|
||||
bool IsEnabled(common::LanguageFeature) const;
|
||||
bool ShouldWarn(common::LanguageFeature) const;
|
||||
bool IsEnabled(common::LanguageFeature feature) const {
|
||||
return languageFeatures_.IsEnabled(feature);
|
||||
}
|
||||
bool ShouldWarn(common::LanguageFeature feature) const {
|
||||
return languageFeatures_.ShouldWarn(feature);
|
||||
}
|
||||
const std::optional<parser::CharBlock> &location() const { return location_; }
|
||||
const std::vector<std::string> &searchDirectories() const {
|
||||
return searchDirectories_;
|
||||
|
|
|
@ -385,7 +385,7 @@ private:
|
|||
|
||||
// Converts, folds, and then checks type, rank, and shape of an
|
||||
// initialization expression for a named constant, a non-pointer
|
||||
// variable static initializatio, a component default initializer,
|
||||
// variable static initialization, a component default initializer,
|
||||
// a type parameter default value, or instantiated type parameter value.
|
||||
std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
|
||||
Expr<SomeType> &&x, FoldingContext &context,
|
||||
|
@ -394,7 +394,20 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
|
|||
if (auto symTS{
|
||||
characteristics::TypeAndShape::Characterize(symbol, context)}) {
|
||||
auto xType{x.GetType()};
|
||||
if (auto converted{ConvertToType(symTS->type(), std::move(x))}) {
|
||||
auto converted{ConvertToType(symTS->type(), Expr<SomeType>{x})};
|
||||
if (!converted &&
|
||||
symbol.owner().context().IsEnabled(
|
||||
common::LanguageFeature::LogicalIntegerAssignment)) {
|
||||
converted = DataConstantConversionExtension(context, symTS->type(), x);
|
||||
if (converted &&
|
||||
symbol.owner().context().ShouldWarn(
|
||||
common::LanguageFeature::LogicalIntegerAssignment)) {
|
||||
context.messages().Say(
|
||||
"nonstandard usage: initialization of %s with %s"_en_US,
|
||||
symTS->type().AsFortran(), x.GetType().value().AsFortran());
|
||||
}
|
||||
}
|
||||
if (converted) {
|
||||
auto folded{Fold(context, std::move(*converted))};
|
||||
if (IsActuallyConstant(folded)) {
|
||||
int symRank{GetRank(symTS->shape())};
|
||||
|
|
|
@ -56,12 +56,14 @@ llvm::raw_ostream &ConstantBase<RESULT, VALUE>::AsFortran(
|
|||
} else if constexpr (Result::category == TypeCategory::Character) {
|
||||
o << Result::kind << '_' << parser::QuoteCharacterLiteral(value, true);
|
||||
} else if constexpr (Result::category == TypeCategory::Logical) {
|
||||
if (value.IsTrue()) {
|
||||
o << ".true.";
|
||||
if (!value.IsCanonical()) {
|
||||
o << "transfer(" << value.word().ToInt64() << "_8,.false._"
|
||||
<< Result::kind << ')';
|
||||
} else if (value.IsTrue()) {
|
||||
o << ".true." << '_' << Result::kind;
|
||||
} else {
|
||||
o << ".false.";
|
||||
o << ".false." << '_' << Result::kind;
|
||||
}
|
||||
o << '_' << Result::kind;
|
||||
} else {
|
||||
StructureConstructor{result_.derivedTypeSpec(), value}.AsFortran(o);
|
||||
}
|
||||
|
|
|
@ -1010,6 +1010,71 @@ const Symbol *GetLastPointerSymbol(const DataRef &x) {
|
|||
return std::visit([](const auto &y) { return GetLastPointerSymbol(y); }, x.u);
|
||||
}
|
||||
|
||||
template <TypeCategory TO, TypeCategory FROM>
|
||||
static std::optional<Expr<SomeType>> DataConstantConversionHelper(
|
||||
FoldingContext &context, const DynamicType &toType,
|
||||
const Expr<SomeType> &expr) {
|
||||
DynamicType sizedType{FROM, toType.kind()};
|
||||
if (auto sized{
|
||||
Fold(context, ConvertToType(sizedType, Expr<SomeType>{expr}))}) {
|
||||
if (const auto *someExpr{UnwrapExpr<Expr<SomeKind<FROM>>>(*sized)}) {
|
||||
return std::visit(
|
||||
[](const auto &w) -> std::optional<Expr<SomeType>> {
|
||||
using FromType = typename std::decay_t<decltype(w)>::Result;
|
||||
static constexpr int kind{FromType::kind};
|
||||
if constexpr (IsValidKindOfIntrinsicType(TO, kind)) {
|
||||
if (const auto *fromConst{UnwrapExpr<Constant<FromType>>(w)}) {
|
||||
using FromWordType = typename FromType::Scalar;
|
||||
using LogicalType = value::Logical<FromWordType::bits>;
|
||||
using ElementType =
|
||||
std::conditional_t<TO == TypeCategory::Logical, LogicalType,
|
||||
typename LogicalType::Word>;
|
||||
std::vector<ElementType> values;
|
||||
auto at{fromConst->lbounds()};
|
||||
auto shape{fromConst->shape()};
|
||||
for (auto n{GetSize(shape)}; n-- > 0;
|
||||
fromConst->IncrementSubscripts(at)) {
|
||||
auto elt{fromConst->At(at)};
|
||||
if constexpr (TO == TypeCategory::Logical) {
|
||||
values.emplace_back(std::move(elt));
|
||||
} else {
|
||||
values.emplace_back(elt.word());
|
||||
}
|
||||
}
|
||||
return {AsGenericExpr(AsExpr(Constant<Type<TO, kind>>{
|
||||
std::move(values), std::move(shape)}))};
|
||||
}
|
||||
}
|
||||
return std::nullopt;
|
||||
},
|
||||
someExpr->u);
|
||||
}
|
||||
}
|
||||
return std::nullopt;
|
||||
}
|
||||
|
||||
std::optional<Expr<SomeType>> DataConstantConversionExtension(
|
||||
FoldingContext &context, const DynamicType &toType,
|
||||
const Expr<SomeType> &expr0) {
|
||||
Expr<SomeType> expr{Fold(context, Expr<SomeType>{expr0})};
|
||||
if (!IsActuallyConstant(expr)) {
|
||||
return std::nullopt;
|
||||
}
|
||||
if (auto fromType{expr.GetType()}) {
|
||||
if (toType.category() == TypeCategory::Logical &&
|
||||
fromType->category() == TypeCategory::Integer) {
|
||||
return DataConstantConversionHelper<TypeCategory::Logical,
|
||||
TypeCategory::Integer>(context, toType, expr);
|
||||
}
|
||||
if (toType.category() == TypeCategory::Integer &&
|
||||
fromType->category() == TypeCategory::Logical) {
|
||||
return DataConstantConversionHelper<TypeCategory::Integer,
|
||||
TypeCategory::Logical>(context, toType, expr);
|
||||
}
|
||||
}
|
||||
return std::nullopt;
|
||||
}
|
||||
|
||||
} // namespace Fortran::evaluate
|
||||
|
||||
namespace Fortran::semantics {
|
||||
|
|
|
@ -284,6 +284,18 @@ DataInitializationCompiler<DSV>::ConvertElement(
|
|||
return {std::make_pair(std::move(*converted), true)};
|
||||
}
|
||||
}
|
||||
SemanticsContext &context{exprAnalyzer_.context()};
|
||||
if (context.IsEnabled(common::LanguageFeature::LogicalIntegerAssignment)) {
|
||||
if (MaybeExpr converted{evaluate::DataConstantConversionExtension(
|
||||
exprAnalyzer_.GetFoldingContext(), type, expr)}) {
|
||||
if (context.ShouldWarn(
|
||||
common::LanguageFeature::LogicalIntegerAssignment)) {
|
||||
context.Say("nonstandard usage: initialization of %s with %s"_en_US,
|
||||
type.AsFortran(), expr.GetType().value().AsFortran());
|
||||
}
|
||||
return {std::make_pair(std::move(*converted), false)};
|
||||
}
|
||||
}
|
||||
return std::nullopt;
|
||||
}
|
||||
|
||||
|
|
|
@ -195,14 +195,6 @@ int SemanticsContext::GetDefaultKind(TypeCategory category) const {
|
|||
return defaultKinds_.GetDefaultKind(category);
|
||||
}
|
||||
|
||||
bool SemanticsContext::IsEnabled(common::LanguageFeature feature) const {
|
||||
return languageFeatures_.IsEnabled(feature);
|
||||
}
|
||||
|
||||
bool SemanticsContext::ShouldWarn(common::LanguageFeature feature) const {
|
||||
return languageFeatures_.ShouldWarn(feature);
|
||||
}
|
||||
|
||||
const DeclTypeSpec &SemanticsContext::MakeNumericType(
|
||||
TypeCategory category, int kind) {
|
||||
if (kind == 0) {
|
||||
|
|
|
@ -43,8 +43,6 @@ subroutine s1
|
|||
data jx/'abc'/
|
||||
!ERROR: DATA statement value could not be converted to the type 'INTEGER(4)' of the object 'jx'
|
||||
data jx/t1()/
|
||||
!ERROR: DATA statement value could not be converted to the type 'INTEGER(4)' of the object 'jx'
|
||||
data jx/.false./
|
||||
!ERROR: DATA statement value 'jy' for 'jx' is not a constant
|
||||
data jx/jy/
|
||||
end subroutine
|
||||
|
|
|
@ -0,0 +1,15 @@
|
|||
! RUN: %flang_fc1 -fdebug-dump-symbols %s 2>&1 | FileCheck %s
|
||||
! Verify initialization extension: integer with logical, logical with integer
|
||||
! CHECK: d (InDataStmt) size=20 offset=40: ObjectEntity type: LOGICAL(4) shape: 1_8:5_8 init:[LOGICAL(4)::transfer(-2_8,.false._4),transfer(-1_8,.false._4),.false._4,.true._4,transfer(2_8,.false._4)]
|
||||
! CHECK: j (InDataStmt) size=8 offset=60: ObjectEntity type: INTEGER(4) shape: 1_8:2_8 init:[INTEGER(4)::0_4,1_4]
|
||||
! CHECK: x, PARAMETER size=20 offset=0: ObjectEntity type: LOGICAL(4) shape: 1_8:5_8 init:[LOGICAL(4)::transfer(-2_8,.false._4),transfer(-1_8,.false._4),.false._4,.true._4,transfer(2_8,.false._4)]
|
||||
! CHECK: y, PARAMETER size=20 offset=20: ObjectEntity type: INTEGER(4) shape: 1_8:5_8 init:[INTEGER(4)::-2_4,-1_4,0_4,1_4,2_4]
|
||||
program main
|
||||
logical, parameter :: x(5) = [ -2, -1, 0, 1, 2 ]
|
||||
integer, parameter :: y(5) = x
|
||||
logical :: d(5)
|
||||
integer :: j(2)
|
||||
data d / -2, -1, 0, 1, 2 /
|
||||
data j / .false., .true. /
|
||||
end
|
||||
|
Loading…
Reference in New Issue