[flang-commits] [flang] 00e0de0 - [flang] Extension: initialization of LOGICAL with INTEGER & vice versa
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Thu Jan 13 14:22:53 PST 2022
Author: Peter Klausler
Date: 2022-01-13T14:22:45-08:00
New Revision: 00e0de05723a0eee491d4a1ddad69b7fe5265805
URL: https://github.com/llvm/llvm-project/commit/00e0de05723a0eee491d4a1ddad69b7fe5265805
DIFF: https://github.com/llvm/llvm-project/commit/00e0de05723a0eee491d4a1ddad69b7fe5265805.diff
LOG: [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
Added:
flang/test/Semantics/data15.f90
Modified:
flang/docs/Extensions.md
flang/include/flang/Evaluate/logical.h
flang/include/flang/Evaluate/tools.h
flang/include/flang/Semantics/semantics.h
flang/lib/Evaluate/check-expression.cpp
flang/lib/Evaluate/formatting.cpp
flang/lib/Evaluate/tools.cpp
flang/lib/Semantics/data-to-inits.cpp
flang/lib/Semantics/semantics.cpp
flang/test/Semantics/data06.f90
Removed:
################################################################################
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index e01c4d7ef37ba..a563d8b64d06b 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -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.
diff --git a/flang/include/flang/Evaluate/logical.h b/flang/include/flang/Evaluate/logical.h
index ba3715a7e46b0..5996853215e30 100644
--- a/flang/include/flang/Evaluate/logical.h
+++ b/flang/include/flang/Evaluate/logical.h
@@ -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 @@ template <int BITS, bool IS_LIKE_C = true> class Logical {
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 @@ template <int BITS, bool IS_LIKE_C = true> class Logical {
}
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_;
};
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index bfb6bcf756a7a..0e2cdcde274c7 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -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 {
diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
index 078c8a026e74b..f0660f6194212 100644
--- a/flang/include/flang/Semantics/semantics.h
+++ b/flang/include/flang/Semantics/semantics.h
@@ -75,8 +75,12 @@ class SemanticsContext {
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_;
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 70b6c1c05e12a..1bb33b62151e3 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -385,7 +385,7 @@ class ArrayConstantBoundChanger {
// 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())};
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index 2569c85e345d0..674c55504f32a 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -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);
}
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 40444385f57b6..34a3b5dd7fcaa 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -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 {
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index be8541efda5d4..b790d31df90fb 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -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;
}
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index f1fa2b349739b..69b37e45aacb0 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -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) {
diff --git a/flang/test/Semantics/data06.f90 b/flang/test/Semantics/data06.f90
index b8dfdb31f37fd..9a5b2d8c48236 100644
--- a/flang/test/Semantics/data06.f90
+++ b/flang/test/Semantics/data06.f90
@@ -43,8 +43,6 @@ real function rfunc(x)
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
diff --git a/flang/test/Semantics/data15.f90 b/flang/test/Semantics/data15.f90
new file mode 100644
index 0000000000000..4c42a33320bfc
--- /dev/null
+++ b/flang/test/Semantics/data15.f90
@@ -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
+
More information about the flang-commits
mailing list