[flang-commits] [PATCH] D130381: [flang] Admit trailing blanks when checking I/O specifiers

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: vdonaldson.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a project: All.
klausler requested review of this revision.

Fortran specifically allows character-valued I/O specifiers
to have trailing blanks, e.g. OPEN(666,STATUS='SCRATCH ').
The runtime I/O library already handles them, but the I/O
static checks in semantics do not.


https://reviews.llvm.org/D130381

Files:
  flang/lib/Semantics/check-io.cpp
  flang/test/Semantics/io02.f90


Index: flang/test/Semantics/io02.f90
===================================================================
--- flang/test/Semantics/io02.f90
+++ flang/test/Semantics/io02.f90
@@ -29,6 +29,9 @@
   !ERROR: Invalid STATUS value 'old'
   close(status='old', unit=17)
 
+  !Ok: trailing spaces ignored
+  close(status='keep ', unit=17)
+
   !ERROR: IOSTAT variable 'const_stat' must be definable
   close(14, iostat=const_stat)
 
Index: flang/lib/Semantics/check-io.cpp
===================================================================
--- flang/lib/Semantics/check-io.cpp
+++ flang/lib/Semantics/check-io.cpp
@@ -97,6 +97,14 @@
   }
 }
 
+// Ignore trailing spaces (12.5.6.2 p1) and convert to upper case
+static std::string Normalize(const std::string &value) {
+  auto upper{parser::ToUpperCaseLetters(value)};
+  std::size_t lastNonBlank{upper.find_last_not_of(" ")};
+  upper.resize(lastNonBlank == std::string::npos ? 0 : lastNonBlank + 1);
+  return upper;
+}
+
 void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) {
   IoSpecKind specKind{};
   using ParseKind = parser::ConnectSpec::CharExpr::Kind;
@@ -150,7 +158,7 @@
   SetSpecifier(specKind);
   if (const std::optional<std::string> charConst{GetConstExpr<std::string>(
           std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {
-    std::string s{parser::ToUpperCaseLetters(*charConst)};
+    std::string s{Normalize(*charConst)};
     if (specKind == IoSpecKind::Access) {
       flags_.set(Flag::KnownAccess);
       flags_.set(Flag::AccessDirect, s == "DIRECT");
@@ -484,8 +492,7 @@
   SetSpecifier(IoSpecKind::Asynchronous);
   if (const std::optional<std::string> charConst{
           GetConstExpr<std::string>(spec)}) {
-    flags_.set(
-        Flag::AsynchronousYes, parser::ToUpperCaseLetters(*charConst) == "YES");
+    flags_.set(Flag::AsynchronousYes, Normalize(*charConst) == "YES");
     CheckStringValue(IoSpecKind::Asynchronous, *charConst,
         parser::FindSourceLocation(spec)); // C1223
   }
@@ -521,8 +528,7 @@
   if (const std::optional<std::string> charConst{GetConstExpr<std::string>(
           std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {
     if (specKind == IoSpecKind::Advance) {
-      flags_.set(
-          Flag::AdvanceYes, parser::ToUpperCaseLetters(*charConst) == "YES");
+      flags_.set(Flag::AdvanceYes, Normalize(*charConst) == "YES");
     }
     CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));
   }
@@ -601,7 +607,7 @@
   if (const std::optional<std::string> charConst{
           GetConstExpr<std::string>(spec)}) {
     // Status values for Open and Close are different.
-    std::string s{parser::ToUpperCaseLetters(*charConst)};
+    std::string s{Normalize(*charConst)};
     if (stmt_ == IoStmtKind::Open) {
       flags_.set(Flag::KnownStatus);
       flags_.set(Flag::StatusNew, s == "NEW");
@@ -868,7 +874,7 @@
       {IoSpecKind::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE"}},
       {IoSpecKind::Dispose, {"DELETE", "KEEP"}},
   };
-  auto upper{parser::ToUpperCaseLetters(value)};
+  auto upper{Normalize(value)};
   if (specValues.at(specKind).count(upper) == 0) {
     if (specKind == IoSpecKind::Access && upper == "APPEND") {
       if (context_.languageFeatures().ShouldWarn(


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D130381.446928.patch
Type: text/x-patch
Size: 3255 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20220722/722a81b9/attachment.bin>