diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md index 3ffd2949e45bf..f85a3eb39ed19 100644 --- a/flang/docs/Extensions.md +++ b/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 diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h index 3942a79262864..648f5b0798fa4 100644 --- a/flang/include/flang/Common/Fortran-features.h +++ b/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, diff --git a/flang/lib/Semantics/rewrite-parse-tree.cpp b/flang/lib/Semantics/rewrite-parse-tree.cpp index b4fb72ce21301..c90ae66342840 100644 --- a/flang/lib/Semantics/rewrite-parse-tree.cpp +++ b/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 diff --git a/flang/test/Semantics/rewrite02.f90 b/flang/test/Semantics/rewrite02.f90 new file mode 100644 index 0000000000000..2393498e65d29 --- /dev/null +++ b/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