Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[flang][runtime] Emit leading spaces in NAMELIST output #76846

Merged
merged 1 commit into from
Jan 15, 2024

Conversation

klausler
Copy link
Contributor

@klausler klausler commented Jan 3, 2024

As NAMELIST output is a variant of list-directed output, its editing must produce leading spaces on (most) output records to effect carriage control. These spaces are required by the language standard and implemented by nearly all other Fortran compilers (except GNU).

Fixes #76798.

As NAMELIST output is a variant of list-directed output, its editing
must produce leading spaces on (most) output records to effect carriage
control.  These spaces are required by the language standard and
implemented by nearly all other Fortran compilers (except GNU).

Fixes llvm#76798.
@llvmbot llvmbot added flang:runtime flang Flang issues not falling into any other category labels Jan 3, 2024
@llvmbot
Copy link
Collaborator

llvmbot commented Jan 3, 2024

@llvm/pr-subscribers-flang-runtime

Author: Peter Klausler (klausler)

Changes

As NAMELIST output is a variant of list-directed output, its editing must produce leading spaces on (most) output records to effect carriage control. These spaces are required by the language standard and implemented by nearly all other Fortran compilers (except GNU).

Fixes #76798.


Full diff: https://github.com/llvm/llvm-project/pull/76846.diff

2 Files Affected:

  • (modified) flang/runtime/namelist.cpp (+15-14)
  • (modified) flang/unittests/Runtime/Namelist.cpp (+6-6)
diff --git a/flang/runtime/namelist.cpp b/flang/runtime/namelist.cpp
index e6997bcf945b80..848ebcf300a3d9 100644
--- a/flang/runtime/namelist.cpp
+++ b/flang/runtime/namelist.cpp
@@ -30,16 +30,15 @@ bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
   IoStatementState &io{*cookie};
   io.CheckFormattedStmtType<Direction::Output>("OutputNamelist");
   io.mutableModes().inNamelist = true;
-  char comma{static_cast<char>(GetComma(io))};
   ConnectionState &connection{io.GetConnectionState()};
-  // Internal functions to advance records and convert case
-  const auto EmitWithAdvance{[&](char ch) -> bool {
-    return (!connection.NeedAdvance(1) || io.AdvanceRecord()) &&
-        EmitAscii(io, &ch, 1);
-  }};
-  const auto EmitUpperCase{[&](const char *str) -> bool {
-    if (connection.NeedAdvance(std::strlen(str)) &&
-        !(io.AdvanceRecord() && EmitAscii(io, " ", 1))) {
+  // Internal function to advance records and convert case
+  const auto EmitUpperCase{[&](const char *prefix, std::size_t prefixLen,
+                               const char *str, char suffix) -> bool {
+    if ((connection.NeedAdvance(prefixLen) &&
+            !(io.AdvanceRecord() && EmitAscii(io, " ", 1))) ||
+        !EmitAscii(io, prefix, prefixLen) ||
+        (connection.NeedAdvance(std::strlen(str) + (suffix != ' ')) &&
+            !(io.AdvanceRecord() && EmitAscii(io, " ", 1)))) {
       return false;
     }
     for (; *str; ++str) {
@@ -49,23 +48,25 @@ bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
         return false;
       }
     }
-    return true;
+    return suffix == ' ' || EmitAscii(io, &suffix, 1);
   }};
   // &GROUP
-  if (!(EmitWithAdvance('&') && EmitUpperCase(group.groupName))) {
+  if (!EmitUpperCase(" &", 2, group.groupName, ' ')) {
     return false;
   }
   auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};
+  char comma{static_cast<char>(GetComma(io))};
+  char prefix{' '};
   for (std::size_t j{0}; j < group.items; ++j) {
     // [,]ITEM=...
     const NamelistGroup::Item &item{group.item[j]};
     if (listOutput) {
       listOutput->set_lastWasUndelimitedCharacter(false);
     }
-    if (!EmitWithAdvance(j == 0 ? ' ' : comma) || !EmitUpperCase(item.name) ||
-        !EmitWithAdvance('=')) {
+    if (!EmitUpperCase(&prefix, 1, item.name, '=')) {
       return false;
     }
+    prefix = comma;
     if (const auto *addendum{item.descriptor.Addendum()};
         addendum && addendum->derivedType()) {
       const NonTbpDefinedIoTable *table{group.nonTbpDefinedIo};
@@ -77,7 +78,7 @@ bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
     }
   }
   // terminal /
-  return EmitWithAdvance('/');
+  return EmitUpperCase("/", 1, "", ' ');
 }
 
 static constexpr bool IsLegalIdStart(char32_t ch) {
diff --git a/flang/unittests/Runtime/Namelist.cpp b/flang/unittests/Runtime/Namelist.cpp
index 5911d67f0d5fc4..f95c5d2e553aa7 100644
--- a/flang/unittests/Runtime/Namelist.cpp
+++ b/flang/unittests/Runtime/Namelist.cpp
@@ -88,7 +88,7 @@ TEST(NamelistTests, BasicSanity) {
   ASSERT_EQ(outStatus1, 0) << "Failed namelist output sanity, status "
                            << static_cast<int>(outStatus1);
 
-  static const std::string expect{"&GROUP1 INTS= 1 -2 4 -8 16 -32  "
+  static const std::string expect{" &GROUP1 INTS= 1 -2 4 -8 16 -32 "
                                   " 64 -128 256 -512 1024 -2048    "
                                   " 4096 -8192 16384 -32768 65536  "
                                   " -131072 262144 -524288,REALS=  "
@@ -157,7 +157,7 @@ TEST(NamelistTests, Subscripts) {
       << "Failed namelist output subscripts rewrite, status "
       << static_cast<int>(outStatus);
   std::string got{out, sizeof out};
-  static const std::string expect{"&JUSTA A= 0 2 0 0 0 1/                  "};
+  static const std::string expect{" &JUSTA A= 0 2 0 0 0 1/                 "};
   EXPECT_EQ(got, expect);
 }
 
@@ -213,7 +213,7 @@ TEST(NamelistTests, ScalarSubstring) {
   ASSERT_TRUE(IONAME(OutputNamelist)(outCookie, group));
   ASSERT_EQ(IONAME(EndIoStatement)(outCookie), IostatOk) << "namelist output";
   std::string got{out, sizeof out};
-  static const std::string expect{"&JUSTA A= 'aBCDEfgh'/           "};
+  static const std::string expect{" &JUSTA A= 'aBCDEfgh'/          "};
   EXPECT_EQ(got, expect);
 }
 
@@ -242,7 +242,7 @@ TEST(NamelistTests, ArraySubstring) {
   ASSERT_TRUE(IONAME(OutputNamelist)(outCookie, group));
   ASSERT_EQ(IONAME(EndIoStatement)(outCookie), IostatOk) << "namelist output";
   std::string got{out, sizeof out};
-  static const std::string expect{"&JUSTA A= 'aBCDEfgh' 'iJKLMnop'/        "};
+  static const std::string expect{" &JUSTA A= 'aBCDEfgh' 'iJKLMnop'/       "};
   EXPECT_EQ(got, expect);
 }
 
@@ -270,7 +270,7 @@ TEST(NamelistTests, Skip) {
   ASSERT_TRUE(IONAME(OutputNamelist)(outCookie, group));
   ASSERT_EQ(IONAME(EndIoStatement)(outCookie), IostatOk) << "namelist output";
   std::string got{out, sizeof out};
-  static const std::string expect{"&NML J= 123/        "};
+  static const std::string expect{" &NML J= 123/       "};
   EXPECT_EQ(got, expect);
 }
 
@@ -301,7 +301,7 @@ TEST(NamelistTests, Comma) {
   ASSERT_TRUE(IONAME(OutputNamelist)(outCookie, group));
   ASSERT_EQ(IONAME(EndIoStatement)(outCookie), IostatOk) << "namelist output";
   std::string got{out, sizeof out};
-  static const std::string expect{"&NML Z= (-1,;2,) (-3,;,5)/    "};
+  static const std::string expect{" &NML Z= (-1,;2,) (-3,;,5)/   "};
   EXPECT_EQ(got, expect);
 }
 

@EugeneZelenko EugeneZelenko removed the flang Flang issues not falling into any other category label Jan 3, 2024
Copy link
Contributor

@psteinfeld psteinfeld left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

All builds and tests correctly and looks good.

@klausler klausler merged commit f08b55d into llvm:main Jan 15, 2024
6 checks passed
@klausler klausler deleted the bug76798 branch January 15, 2024 18:02
justinfargnoli pushed a commit to justinfargnoli/llvm-project that referenced this pull request Jan 28, 2024
As NAMELIST output is a variant of list-directed output, its editing
must produce leading spaces on (most) output records to effect carriage
control. These spaces are required by the language standard and
implemented by nearly all other Fortran compilers (except GNU).

Fixes llvm#76798.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

Successfully merging this pull request may close these issues.

In NAMELIST output editing, leading blank is missing.
4 participants