[flang-commits] [flang] 43b304b - [flang] Support DATA statement initialization of numeric with Hollerith/CHARACTER

[peter klausler via flang-commits]

Author: peter klausler
Date: 2020-08-07T13:17:36-07:00
New Revision: 43b304b09f892c305861de3113967c2714ab0d02

URL: https://github.com/llvm/llvm-project/commit/43b304b09f892c305861de3113967c2714ab0d02
DIFF: https://github.com/llvm/llvm-project/commit/43b304b09f892c305861de3113967c2714ab0d02.diff

LOG: [flang] Support DATA statement initialization of numeric with Hollerith/CHARACTER

This is a common Fortran language extension.

Differential Revision: https://reviews.llvm.org/D85492

Added: 
    flang/test/Semantics/data08.f90

Modified: 
    flang/lib/Semantics/check-data.cpp
    flang/test/Semantics/data06.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp
index 1aa52f06f642..49e28ba3a091 100644
--- a/flang/lib/Semantics/check-data.cpp
+++ b/flang/lib/Semantics/check-data.cpp
@@ -287,6 +287,9 @@ class DataInitializationCompiler {
   bool InitDesignator(const SomeExpr &);
   // Initializes a single object.
   bool InitElement(const evaluate::OffsetSymbol &, const SomeExpr &designator);
+  // If the returned flag is true, emit a warning about CHARACTER misusage.
+  std::optional<std::pair<SomeExpr, bool>> ConvertElement(
+      const SomeExpr &, const evaluate::DynamicType &);
 
   DataInitializations &inits_;
   evaluate::ExpressionAnalyzer &exprAnalyzer_;
@@ -406,6 +409,32 @@ bool DataInitializationCompiler::InitDesignator(const SomeExpr &designator) {
   return folder.isEmpty();
 }
 
+std::optional<std::pair<SomeExpr, bool>>
+DataInitializationCompiler::ConvertElement(
+    const SomeExpr &expr, const evaluate::DynamicType &type) {
+  if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) {
+    return {std::make_pair(std::move(*converted), false)};
+  }
+  if (std::optional<std::string> chValue{evaluate::GetScalarConstantValue<
+          evaluate::Type<TypeCategory::Character, 1>>(expr)}) {
+    // Allow DATA initialization with Hollerith and kind=1 CHARACTER like
+    // (most) other Fortran compilers do.  Pad on the right with spaces
+    // when short, truncate the right if long.
+    // TODO: big-endian targets
+    std::size_t bytes{type.MeasureSizeInBytes().value()};
+    evaluate::BOZLiteralConstant bits{0};
+    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)};
+    }
+  }
+  return std::nullopt;
+}
+
 bool DataInitializationCompiler::InitElement(
     const evaluate::OffsetSymbol &offsetSymbol, const SomeExpr &designator) {
   const Symbol &symbol{offsetSymbol.symbol()};
@@ -491,16 +520,19 @@ bool DataInitializationCompiler::InitElement(
         "Initializer for '%s' must not be a procedure"_err_en_US,
         DescribeElement());
   } else if (auto designatorType{designator.GetType()}) {
-    if (auto converted{
-            evaluate::ConvertToType(*designatorType, SomeExpr{*expr})}) {
+    if (auto converted{ConvertElement(*expr, *designatorType)}) {
       // value non-pointer initialization
       if (std::holds_alternative<evaluate::BOZLiteralConstant>(expr->u) &&
           designatorType->category() != TypeCategory::Integer) { // 8.6.7(11)
         exprAnalyzer_.Say(values_.LocateSource(),
             "BOZ literal should appear in a DATA statement only as a value for an integer object, but '%s' is '%s'"_en_US,
             DescribeElement(), designatorType->AsFortran());
+      } else if (converted->second) {
+        exprAnalyzer_.context().Say(
+            "DATA statement value initializes '%s' of type '%s' with CHARACTER"_en_US,
+            DescribeElement(), designatorType->AsFortran());
       }
-      auto folded{evaluate::Fold(context, std::move(*converted))};
+      auto folded{evaluate::Fold(context, std::move(converted->first))};
       switch (
           GetImage().Add(offsetSymbol.offset(), offsetSymbol.size(), folded)) {
       case evaluate::InitialImage::Ok:

diff  --git a/flang/test/Semantics/data06.f90 b/flang/test/Semantics/data06.f90
index c21b99e8e484..4743eff3b8b6 100644
--- a/flang/test/Semantics/data06.f90
+++ b/flang/test/Semantics/data06.f90
@@ -39,7 +39,7 @@ real function rfunc(x)
   !ERROR: Initializer for 'rt' must not be a procedure
   data rt/rfunc/
   integer :: jx, jy
-  !ERROR: DATA statement value could not be converted to the type 'INTEGER(4)' of the object 'jx'
+  !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()/

diff  --git a/flang/test/Semantics/data08.f90 b/flang/test/Semantics/data08.f90
new file mode 100644
index 000000000000..86a87f90163f
--- /dev/null
+++ b/flang/test/Semantics/data08.f90
@@ -0,0 +1,17 @@
+! RUN: %f18 -fdebug-dump-symbols -fparse-only %s 2>&1 | FileCheck %s
+! CHECK: DATA statement value initializes 'jx' of type 'INTEGER(4)' with CHARACTER
+! CHECK: DATA statement value initializes 'jy' of type 'INTEGER(4)' with CHARACTER
+! CHECK: DATA statement value initializes 'jz' of type 'INTEGER(4)' with CHARACTER
+! CHECK: DATA statement value initializes 'kx' of type 'INTEGER(8)' with CHARACTER
+! CHECK: jx (InDataStmt) size=4 offset=0: ObjectEntity type: INTEGER(4) init:1684234849_4
+! CHECK: jy (InDataStmt) size=4 offset=4: ObjectEntity type: INTEGER(4) init:543384161_4
+! CHECK: jz (InDataStmt) size=4 offset=8: ObjectEntity type: INTEGER(4) init:1684234849_4
+! CHECK: kx (InDataStmt) size=8 offset=16: ObjectEntity type: INTEGER(8) init:7523094288207667809_8
+
+integer :: jx, jy, jz
+integer(8) :: kx
+data jx/4habcd/
+data jy/3habc/
+data jz/5habcde/
+data kx/'abcdefgh'/
+end