From 0e55f2463ba73136f10cdeb94cf78d2a996d0d3b Mon Sep 17 00:00:00 2001
From: peter klausler <pklausler@nvidia.com>
Date: Tue, 9 Apr 2019 16:36:29 -0700
Subject: [PATCH] [flang] Rewrite read-stmt/write-stmt parse trees for
 misparsed namelist group names

Original-commit: flang-compiler/f18@e0f1b1c469eab3242748e5edbf0f163d750348e5
Reviewed-on: https://github.com/flang-compiler/f18/pull/394
Tree-same-pre-rewrite: false
---
 flang/lib/parser/parse-tree.h             |  4 ++--
 flang/lib/semantics/rewrite-parse-tree.cc | 38 +++++++++++++++++++++++++++++++
 2 files changed, 40 insertions(+), 2 deletions(-)

diff --git a/flang/lib/parser/parse-tree.h b/flang/lib/parser/parse-tree.h
index 1d2e1d1..cfe0e45 100644
--- a/flang/lib/parser/parse-tree.h
+++ b/flang/lib/parser/parse-tree.h
@@ -2613,7 +2613,7 @@ struct ReadStmt {
   std::optional<IoUnit> iounit;  // if first in controls without UNIT=
   std::optional<Format> format;  // if second in controls without FMT=, or
                                  // no (io-control-spec-list); might be
-                                 // an untagged namelist group name (TODO)
+                                 // an untagged namelist group name, too
   std::list<IoControlSpec> controls;
   std::list<InputItem> items;
 };
@@ -2633,7 +2633,7 @@ struct WriteStmt {
       items(std::move(its)) {}
   std::optional<IoUnit> iounit;  // if first in controls without UNIT=
   std::optional<Format> format;  // if second in controls without FMT=;
-                                 // might be an untagged namelist group (TODO)
+                                 // might be an untagged namelist group, too
   std::list<IoControlSpec> controls;
   std::list<OutputItem> items;
 };
diff --git a/flang/lib/semantics/rewrite-parse-tree.cc b/flang/lib/semantics/rewrite-parse-tree.cc
index a1cd773..cd87829 100644
--- a/flang/lib/semantics/rewrite-parse-tree.cc
+++ b/flang/lib/semantics/rewrite-parse-tree.cc
@@ -26,6 +26,7 @@ namespace Fortran::semantics {
 using namespace parser::literals;
 
 /// Convert mis-identified statement functions to array element assignments.
+/// Convert mis-identified format expressions to namelist group names.
 class RewriteMutator {
 public:
   RewriteMutator(parser::Messages &messages) : messages_{messages} {}
@@ -37,6 +38,8 @@ public:
   void Post(parser::Name &);
   void Post(parser::SpecificationPart &);
   bool Pre(parser::ExecutionPart &);
+  void Post(parser::ReadStmt &);
+  void Post(parser::WriteStmt &);
 
   // Name resolution yet implemented:
   bool Pre(parser::EquivalenceStmt &) { return false; }
@@ -101,6 +104,41 @@ bool RewriteMutator::Pre(parser::ExecutionPart &x) {
   return true;
 }
 
+// When a namelist group name appears (without NML=) in a READ or WRITE
+// statement in such a way that it can be misparsed as a format expression,
+// rewrite the I/O statement's parse tree node as if the namelist group
+// name had appeared with NML=.
+template<typename READ_OR_WRITE>
+void FixMisparsedUntaggedNamelistName(READ_OR_WRITE &x) {
+  if (x.format.has_value()) {
+    if (auto *charExpr{
+            std::get_if<parser::DefaultCharExpr>(&x.format.value().u)}) {
+      parser::Expr &expr{charExpr->thing.value()};
+      if (auto *designator{
+              std::get_if<common::Indirection<parser::Designator>>(&expr.u)}) {
+        parser::Name *name{
+            std::get_if<parser::ObjectName>(&designator->value().u)};
+        if (auto *dr{std::get_if<parser::DataRef>(&designator->value().u)}) {
+          name = std::get_if<parser::Name>(&dr->u);
+        }
+        if (name != nullptr && name->symbol != nullptr &&
+            name->symbol->has<NamelistDetails>()) {
+          x.controls.emplace_front(parser::IoControlSpec{std::move(*name)});
+          x.format.reset();
+        }
+      }
+    }
+  }
+}
+
+void RewriteMutator::Post(parser::ReadStmt &x) {
+  FixMisparsedUntaggedNamelistName(x);
+}
+
+void RewriteMutator::Post(parser::WriteStmt &x) {
+  FixMisparsedUntaggedNamelistName(x);
+}
+
 bool RewriteParseTree(SemanticsContext &context, parser::Program &program) {
   RewriteMutator mutator{context.messages()};
   parser::Walk(program, mutator);
-- 
2.7.4