[flang-commits] [flang] 2dab5bd - [flang] Warn on mismatched DATA substring sizes rather than crashing

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-02-13T12:31:05-08:00
New Revision: 2dab5bdf89f6e62e48b6b8364abae0c8e6c2fa0c

URL: https://github.com/llvm/llvm-project/commit/2dab5bdf89f6e62e48b6b8364abae0c8e6c2fa0c
DIFF: https://github.com/llvm/llvm-project/commit/2dab5bdf89f6e62e48b6b8364abae0c8e6c2fa0c.diff

LOG: [flang] Warn on mismatched DATA substring sizes rather than crashing

When a DATA statement initializes a substring with a character constant
of the wrong length, do the right thing with blank padding or truncation,
and emit a warning.  Current code is crashing due to an unhandled error
reported from the low-level data image initialization framework.

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

Added: 
    flang/test/Semantics/data17.f90

Modified: 
    flang/include/flang/Evaluate/initial-image.h
    flang/lib/Semantics/data-to-inits.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Evaluate/initial-image.h b/flang/include/flang/Evaluate/initial-image.h
index 8e931bb3845bd..d5b30f53a7660 100644
--- a/flang/include/flang/Evaluate/initial-image.h
+++ b/flang/include/flang/Evaluate/initial-image.h
@@ -72,20 +72,22 @@ class InitialImage {
       } else if (bytes == 0) {
         return Ok;
       } else {
+        Result result{Ok};
         for (auto at{x.lbounds()}; elements-- > 0; x.IncrementSubscripts(at)) {
           auto scalar{x.At(at)}; // this is a std string; size() in chars
-          // Subtle: an initializer for a substring may have been
-          // expanded to the length of the entire string.
           auto scalarBytes{scalar.size() * KIND};
-          if (scalarBytes < elementBytes ||
-              (scalarBytes > elementBytes && elements != 0)) {
-            return SizeMismatch;
+          if (scalarBytes != elementBytes) {
+            result = SizeMismatch;
+          }
+          // Blank padding when short
+          for (; scalarBytes < elementBytes; scalarBytes += KIND) {
+            scalar += ' ';
           }
           // TODO endianness
           std::memcpy(&data_.at(offset), scalar.data(), elementBytes);
           offset += elementBytes;
         }
-        return Ok;
+        return result;
       }
     }
   }

diff  --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index aaa118b32ffe2..d91a2503a699c 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -448,6 +448,11 @@ bool DataInitializationCompiler<DSV>::InitElement(
       case evaluate::InitialImage::OutOfRange:
         OutOfRangeError();
         break;
+      case evaluate::InitialImage::SizeMismatch:
+        exprAnalyzer_.Say(
+            "DATA statement value '%s' for '%s' has the wrong length"_warn_en_US,
+            folded.AsFortran(), DescribeElement());
+        break;
       default:
         CHECK(exprAnalyzer_.context().AnyFatalError());
         break;

diff  --git a/flang/test/Semantics/data17.f90 b/flang/test/Semantics/data17.f90
new file mode 100644
index 0000000000000..8ea9d785a96fb
--- /dev/null
+++ b/flang/test/Semantics/data17.f90
@@ -0,0 +1,11 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+character(4) a, b, c, d, e
+!WARNING: DATA statement value '"abcde"' for 'a' has the wrong length
+data a(1:4)/'abcde'/
+!WARNING: DATA statement value '"abc"' for 'b' has the wrong length
+data b(1:4)/'abc'/
+data c/'abcde'/ ! not a substring, conforms
+data d/'abc'/ ! not a substring, conforms
+!ERROR: DATA statement designator 'e(1_8:5_8)' is out of range
+data e(1:5)/'xyz'/
+end