[flang] Support "PRINT namelistname" (#112024)

Nearly every Fortran compiler supports "PRINT namelistname" as a synonym
for "WRITE (*, NML=namelistname)". Implement this extension via parse
tree rewriting.

Fixes #111738.

Author: klausler

flang/docs/Extensions.md

@@ -389,6 +389,8 @@ end
 * A local data object may appear in a specification expression, even
   when it is not a dummy argument or in COMMON, so long as it is
   has the SAVE attribute and was initialized.
+* `PRINT namelistname` is accepted and interpreted as
+  `WRITE(*,NML=namelistname)`, a near-universal extension.
 
 ### Extensions supported when enabled by options
 

flang/include/flang/Common/Fortran-features.h

@@ -53,7 +53,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     NonBindCInteroperability, CudaManaged, CudaUnified,
     PolymorphicActualAllocatableOrPointerToMonomorphicDummy, RelaxedPureDummy,
     UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram, PrintCptr,
-    SavedLocalInSpecExpr)
+    SavedLocalInSpecExpr, PrintNamelist)
 
 // Portability and suspicious usage warnings
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,

flang/lib/Semantics/rewrite-parse-tree.cpp

@@ -32,7 +32,7 @@ using namespace parser::literals;
 class RewriteMutator {
 public:
   RewriteMutator(SemanticsContext &context)
-      : errorOnUnresolvedName_{!context.AnyFatalError()},
+      : context_{context}, errorOnUnresolvedName_{!context.AnyFatalError()},
         messages_{context.messages()} {}
 
   // Default action for a parse tree node is to visit children.
@@ -42,6 +42,7 @@ class RewriteMutator {
   void Post(parser::Name &);
   void Post(parser::SpecificationPart &);
   bool Pre(parser::ExecutionPart &);
+  bool Pre(parser::ActionStmt &);
   void Post(parser::ReadStmt &);
   void Post(parser::WriteStmt &);
 
@@ -66,6 +67,7 @@ class RewriteMutator {
 private:
   using stmtFuncType =
       parser::Statement<common::Indirection<parser::StmtFunctionStmt>>;
+  SemanticsContext &context_;
   bool errorOnUnresolvedName_{true};
   parser::Messages &messages_;
   std::list<stmtFuncType> stmtFuncsToConvert_;
@@ -130,6 +132,29 @@ bool RewriteMutator::Pre(parser::ExecutionPart &x) {
   return true;
 }
 
+// Rewrite PRINT NML -> WRITE(*,NML=NML)
+bool RewriteMutator::Pre(parser::ActionStmt &x) {
+  if (auto *print{std::get_if<common::Indirection<parser::PrintStmt>>(&x.u)};
+      print &&
+      std::get<std::list<parser::OutputItem>>(print->value().t).empty()) {
+    auto &format{std::get<parser::Format>(print->value().t)};
+    if (std::holds_alternative<parser::Expr>(format.u)) {
+      if (auto *name{parser::Unwrap<parser::Name>(format)}; name &&
+          name->symbol && name->symbol->GetUltimate().has<NamelistDetails>() &&
+          context_.IsEnabled(common::LanguageFeature::PrintNamelist)) {
+        context_.Warn(common::LanguageFeature::PrintNamelist, name->source,
+            "nonstandard: namelist in PRINT statement"_port_en_US);
+        std::list<parser::IoControlSpec> controls;
+        controls.emplace_back(std::move(*name));
+        x.u = common::Indirection<parser::WriteStmt>::Make(
+            parser::IoUnit{parser::Star{}}, std::optional<parser::Format>{},
+            std::move(controls), std::list<parser::OutputItem>{});
+      }
+    }
+  }
+  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

flang/test/Semantics/rewrite02.f90

@@ -0,0 +1,8 @@
+!RUN: %flang_fc1 -fdebug-unparse -pedantic %s  2>&1 | FileCheck %s
+!Test rewrite of "PRINT namelistname" into "WRITE(*,NML=namelistname)"
+!CHECK: nonstandard: namelist in PRINT statement
+namelist /nml/x
+x = 123.
+!CHECK: WRITE (*, NML=nml)
+print nml
+end