From 2dab5bdf89f6e62e48b6b8364abae0c8e6c2fa0c Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Mon, 6 Feb 2023 16:40:21 -0800 Subject: [PATCH] [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 --- flang/include/flang/Evaluate/initial-image.h | 14 ++++++++------ flang/lib/Semantics/data-to-inits.cpp | 5 +++++ flang/test/Semantics/data17.f90 | 11 +++++++++++ 3 files changed, 24 insertions(+), 6 deletions(-) create mode 100644 flang/test/Semantics/data17.f90 diff --git a/flang/include/flang/Evaluate/initial-image.h b/flang/include/flang/Evaluate/initial-image.h index 8e931bb..d5b30f5 100644 --- a/flang/include/flang/Evaluate/initial-image.h +++ b/flang/include/flang/Evaluate/initial-image.h @@ -72,20 +72,22 @@ public: } 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 aaa118b..d91a250 100644 --- a/flang/lib/Semantics/data-to-inits.cpp +++ b/flang/lib/Semantics/data-to-inits.cpp @@ -448,6 +448,11 @@ bool DataInitializationCompiler::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 0000000..8ea9d78 --- /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 -- 2.7.4