[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

 * When a scalar CHARACTER actual argument of the same kind is known to
   have a length shorter than the associated dummy argument, it is extended
   on the right with blanks, similar to assignment.
 * When a dummy argument is `POINTER` or `ALLOCATABLE` and is `INTENT(IN)`, we
   relax enforcement of some requirements on actual arguments that must otherwise
   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.
 * DATA statement initialization is allowed for procedure pointers outside
   structure constructors.
 * Nonstandard intrinsic functions: ISNAN, SIZEOF
 * A forward reference to a default INTEGER scalar dummy argument is
   permitted to appear in a specification expression, such as an array

flang/include/flang/Evaluate/logical.h

 #include "integer.h"
 #include <cinttypes>
 
 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).
   static constexpr bool IsLikeC{BITS <= 8 || IS_LIKE_C};
 
   constexpr Logical() {} // .FALSE.
   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
   // std::set<> & std::map<>.
   template <int B, bool C>
   constexpr bool operator<(const Logical<B, C> &that) const {
     return !IsTrue() && that.IsTrue();
   }
public:
 
   constexpr Logical EQV(const Logical &that) const { return NEQV(that).NOT(); }
 
   constexpr Logical NEQV(const Logical &that) const {
     return {word_.IEOR(that.word_)};
   }
 
 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_;
 };
 
 extern template class Logical<8>;
 extern template class Logical<16>;
 extern template class Logical<32>;
 extern template class Logical<64>;
 } // namespace Fortran::evaluate::value
 #endif // FORTRAN_EVALUATE_LOGICAL_H_

flang/include/flang/Evaluate/tools.h

Constant<T> PackageConstant(std::vector<Scalar<T>> &&elements,
   } else if constexpr (T::category == TypeCategory::Derived) {
     return Constant<T>{reference.GetType().GetDerivedTypeSpec(),
         std::move(elements), ConstantSubscripts{shape}};
   } else {
     return Constant<T>{std::move(elements), ConstantSubscripts{shape}};
   }
 }
 
+// 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 {
 
 class Scope;
 
 // If a symbol represents an ENTRY, return the symbol of the main entry
 // point to its subprogram.

flang/include/flang/Semantics/semantics.h

public:
   const common::LanguageFeatureControl &languageFeatures() const {
     return languageFeatures_;
   };
   int GetDefaultKind(TypeCategory) const;
   int doublePrecisionKind() const {
     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_;
   }
   const std::string &moduleDirectory() const { return moduleDirectory_; }
   const std::string &moduleFileSuffix() const { return moduleFileSuffix_; }
   bool warnOnNonstandardUsage() const { return warnOnNonstandardUsage_; }
   bool warningsAreErrors() const { return warningsAreErrors_; }

flang/lib/Evaluate/check-expression.cpp

public:
   }
 
 private:
   ConstantSubscripts &&lbounds_;
 };
 
 // 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,
     const semantics::Scope *instantiation) {
   CHECK(!IsPointer(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())};
         if (IsImpliedShape(symbol)) {
           if (folded.Rank() == symRank) {
             return {std::move(folded)};
           } else {
             context.messages().Say(

flang/lib/Evaluate/formatting.cpp

for (const auto &value : values_) {
     if constexpr (Result::category == TypeCategory::Integer) {
       o << value.SignedDecimal() << '_' << Result::kind;
     } else if constexpr (Result::category == TypeCategory::Real ||
         Result::category == TypeCategory::Complex) {
       value.AsFortran(o, Result::kind);
     } 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);
     }
   }
   if (Rank() > 0) {
     o << ']';
   }
   ShapeAsFortran(o, shape());

flang/lib/Evaluate/tools.cpp

 }
 static const Symbol *GetLastPointerSymbol(const CoarrayRef &x) {
   return nullptr;
 }
 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 {
 
 const Symbol &ResolveAssociations(const Symbol &original) {
   const Symbol &symbol{original.GetUltimate()};
   if (const auto *details{symbol.detailsIf<AssocEntityDetails>()}) {
     if (const Symbol * nested{UnwrapWholeSymbolDataRef(details->expr())}) {

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

 
 template <typename DSV>
 bool DataInitializationCompiler<DSV>::InitDesignator(
     const SomeExpr &designator) {
   evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
   evaluate::DesignatorFolder folder{context};
   while (auto offsetSymbol{folder.FoldDesignator(designator)}) {
     if (folder.isOutOfRange()) {
       if (auto bad{evaluate::OffsetToDesignator(context, *offsetSymbol)}) {
         exprAnalyzer_.context().Say(
             "DATA statement designator '%s' is out of range"_err_en_US,
             bad->AsFortran());
       } else {
         exprAnalyzer_.context().Say(
             "DATA statement designator '%s' is out of range"_err_en_US,
             designator.AsFortran());
       }
for (std::size_t j{0}; j < bytes; ++j) {
       char ch{j >= chValue->size() ? ' ' : chValue->at(j)};
       evaluate::BOZLiteralConstant chBOZ{static_cast<unsigned char>(ch)};
       bits = bits.IOR(chBOZ.SHIFTL(8 * j));
     }
     if (auto converted{evaluate::ConvertToType(type, SomeExpr{bits})}) {
       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;
 }
 
 template <typename DSV>
 bool DataInitializationCompiler<DSV>::InitElement(
     const evaluate::OffsetSymbol &offsetSymbol, const SomeExpr &designator) {
   const Symbol &symbol{offsetSymbol.symbol()};
   const Symbol *lastSymbol{GetLastSymbol(designator)};

flang/lib/Semantics/semantics.cpp

: defaultKinds_{defaultKinds}, languageFeatures_{languageFeatures},
                                defaultKinds_, intrinsics_} {}
 
 SemanticsContext::~SemanticsContext() {}
 
 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) {
     kind = GetDefaultKind(category);
   }
   return globalScope_.MakeNumericType(category, KindExpr{kind});
 }
 const DeclTypeSpec &SemanticsContext::MakeLogicalType(int kind) {

flang/test/Semantics/data06.f90

subroutine s1
   data rt/null()/
   !ERROR: Initializer for 'rt' must not be a procedure
   data rt/rfunc/
   integer :: jx, jy
   !WARNING: DATA statement value initializes 'jx' of type 'INTEGER(4)' with CHARACTER
   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
+