[flang] Extension: initialization of LOGICAL with INTEGER & vice versa

[klausler]

Summary

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.

[jeanPerier]

Please check why the buildbots are failing in data-to-inits.cpp. Logic looks good to me.
We will have to do something in lowering to support this feature, I think lowering would currently canonicalize the value when lowering initializers.

flang/lib/Semantics/data-to-inits.cpp

242

LLVM builds raise error expected ';' at end of declaration here (see bots).

[klausler]

Correct build issue.

[klausler]

Rebase and resolve confict.

flang/docs/Extensions.md

   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.

flang/include/flang/Evaluate/logical.h

 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).

   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

   }
 
 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_;
 };
 

flang/include/flang/Evaluate/tools.h

   }
 }
 
+// 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 {

flang/include/flang/Semantics/semantics.h

     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_;

flang/lib/Evaluate/check-expression.cpp

 
 // 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,

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

flang/lib/Evaluate/formatting.cpp

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

flang/lib/Evaluate/tools.cpp

   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 {

flang/lib/Semantics/data-to-inits.cpp

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

flang/lib/Semantics/semantics.cpp

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

flang/test/Semantics/data06.f90

   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

flang/test/Semantics/data15.f90

+! 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
+