[flang] New -fdebug-unparse-with-modules option (#91660)

This option is a compilation action that parses a source file and
performs semantic analysis on it, like the existing -fdebug-unparse
option does. Its output, however, is preceded by the effective contents
of all of the non-intrinsic modules on which it depends but does not
define, transitively preceded by the closure of all of those modules'
dependencies.

The output from this option is therefore the analyzed parse tree for a
source file encapsulated with all of its non-intrinsic module
dependencies. This output may be useful for extracting code from large
applications for use as an attachment to a bug report, or as input to a
test case reduction tool for problem isolation.

10 files changed, 119 insertions, 2 deletions

diff --git a/flang/include/flang/Frontend/FrontendActions.h b/flang/include/flang/Frontend/FrontendActions.h
index e2e859f..7823565 100644
--- a/flang/include/flang/Frontend/FrontendActions.h
+++ b/flang/include/flang/Frontend/FrontendActions.h
@@ -108,6 +108,10 @@ class DebugUnparseWithSymbolsAction : public PrescanAndSemaAction {
   void executeAction() override;
 };
 
+class DebugUnparseWithModulesAction : public PrescanAndSemaAction {
+  void executeAction() override;
+};
+
 class DebugUnparseAction : public PrescanAndSemaAction {
   void executeAction() override;
 };
diff --git a/flang/include/flang/Frontend/FrontendOptions.h b/flang/include/flang/Frontend/FrontendOptions.h
index 06b1318..82ca996 100644
--- a/flang/include/flang/Frontend/FrontendOptions.h
+++ b/flang/include/flang/Frontend/FrontendOptions.h
@@ -63,6 +63,10 @@ enum ActionKind {
   /// Fortran source file
   DebugUnparseWithSymbols,
 
+  /// Parse, run semantics, and output a Fortran source file preceded
+  /// by all the necessary modules (transitively)
+  DebugUnparseWithModules,
+
   /// Parse, run semantics and then output symbols from semantics
   DebugDumpSymbols,
 
diff --git a/flang/include/flang/Semantics/unparse-with-symbols.h b/flang/include/flang/Semantics/unparse-with-symbols.h
index d701102..5e18b3f 100644
--- a/flang/include/flang/Semantics/unparse-with-symbols.h
+++ b/flang/include/flang/Semantics/unparse-with-symbols.h
@@ -21,8 +21,12 @@ struct Program;
 }
 
 namespace Fortran::semantics {
+class SemanticsContext;
 void UnparseWithSymbols(llvm::raw_ostream &, const parser::Program &,
     parser::Encoding encoding = parser::Encoding::UTF_8);
+void UnparseWithModules(llvm::raw_ostream &, SemanticsContext &,
+    const parser::Program &,
+    parser::Encoding encoding = parser::Encoding::UTF_8);
 }
 
 #endif // FORTRAN_SEMANTICS_UNPARSE_WITH_SYMBOLS_H_
diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp
index db7fd3c..e8a8c90 100644
--- a/flang/lib/Frontend/CompilerInvocation.cpp
+++ b/flang/lib/Frontend/CompilerInvocation.cpp
@@ -488,6 +488,9 @@ static bool parseFrontendArgs(FrontendOptions &opts, llvm::opt::ArgList &args,
     case clang::driver::options::OPT_fdebug_unparse_with_symbols:
       opts.programAction = DebugUnparseWithSymbols;
       break;
+    case clang::driver::options::OPT_fdebug_unparse_with_modules:
+      opts.programAction = DebugUnparseWithModules;
+      break;
     case clang::driver::options::OPT_fdebug_dump_symbols:
       opts.programAction = DebugDumpSymbols;
       break;
diff --git a/flang/lib/Frontend/FrontendActions.cpp b/flang/lib/Frontend/FrontendActions.cpp
index 2f65ab6..4341c10 100644
--- a/flang/lib/Frontend/FrontendActions.cpp
+++ b/flang/lib/Frontend/FrontendActions.cpp
@@ -477,6 +477,15 @@ void DebugUnparseWithSymbolsAction::executeAction() {
   reportFatalSemanticErrors();
 }
 
+void DebugUnparseWithModulesAction::executeAction() {
+  auto &parseTree{*getInstance().getParsing().parseTree()};
+  CompilerInstance &ci{getInstance()};
+  Fortran::semantics::UnparseWithModules(
+      llvm::outs(), ci.getSemantics().context(), parseTree,
+      /*encoding=*/Fortran::parser::Encoding::UTF_8);
+  reportFatalSemanticErrors();
+}
+
 void DebugDumpSymbolsAction::executeAction() {
   CompilerInstance &ci = this->getInstance();
 
diff --git a/flang/lib/FrontendTool/ExecuteCompilerInvocation.cpp b/flang/lib/FrontendTool/ExecuteCompilerInvocation.cpp
index 4cad640..e2cbd51 100644
--- a/flang/lib/FrontendTool/ExecuteCompilerInvocation.cpp
+++ b/flang/lib/FrontendTool/ExecuteCompilerInvocation.cpp
@@ -59,6 +59,8 @@ createFrontendAction(CompilerInstance &ci) {
     return std::make_unique<DebugUnparseNoSemaAction>();
   case DebugUnparseWithSymbols:
     return std::make_unique<DebugUnparseWithSymbolsAction>();
+  case DebugUnparseWithModules:
+    return std::make_unique<DebugUnparseWithModulesAction>();
   case DebugDumpSymbols:
     return std::make_unique<DebugDumpSymbolsAction>();
   case DebugDumpParseTree:
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index e9aebe5..bb8c6c7 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -132,11 +132,11 @@ static std::string ModFileName(const SourceName &name,
 
 // Write the module file for symbol, which must be a module or submodule.
 void ModFileWriter::Write(const Symbol &symbol) {
-  auto &module{symbol.get<ModuleDetails>()};
+  const auto &module{symbol.get<ModuleDetails>()};
   if (module.moduleFileHash()) {
     return; // already written
   }
-  auto *ancestor{module.ancestor()};
+  const auto *ancestor{module.ancestor()};
   isSubmodule_ = ancestor != nullptr;
   auto ancestorName{ancestor ? ancestor->GetName().value().ToString() : ""s};
   auto path{context_.moduleDirectory() + '/' +
@@ -151,6 +151,21 @@ void ModFileWriter::Write(const Symbol &symbol) {
   const_cast<ModuleDetails &>(module).set_moduleFileHash(checkSum);
 }
 
+void ModFileWriter::WriteClosure(llvm::raw_ostream &out, const Symbol &symbol,
+    UnorderedSymbolSet &nonIntrinsicModulesWritten) {
+  if (!symbol.has<ModuleDetails>() || symbol.owner().IsIntrinsicModules() ||
+      !nonIntrinsicModulesWritten.insert(symbol).second) {
+    return;
+  }
+  PutSymbols(DEREF(symbol.scope()));
+  needsBuf_.clear(); // omit module checksums
+  auto str{GetAsString(symbol)};
+  for (auto depRef : std::move(usedNonIntrinsicModules_)) {
+    WriteClosure(out, *depRef, nonIntrinsicModulesWritten);
+  }
+  out << std::move(str);
+}
+
 // Return the entire body of the module file
 // and clear saved uses, decls, and contains.
 std::string ModFileWriter::GetAsString(const Symbol &symbol) {
@@ -710,6 +725,7 @@ void ModFileWriter::PutUse(const Symbol &symbol) {
     uses_ << "use,intrinsic::";
   } else {
     uses_ << "use ";
+    usedNonIntrinsicModules_.insert(module);
   }
   uses_ << module.name() << ",only:";
   PutGenericName(uses_, symbol);
diff --git a/flang/lib/Semantics/mod-file.h b/flang/lib/Semantics/mod-file.h
index b4ece40..739add3 100644
--- a/flang/lib/Semantics/mod-file.h
+++ b/flang/lib/Semantics/mod-file.h
@@ -35,6 +35,8 @@ class ModFileWriter {
 public:
   explicit ModFileWriter(SemanticsContext &context) : context_{context} {}
   bool WriteAll();
+  void WriteClosure(llvm::raw_ostream &, const Symbol &,
+      UnorderedSymbolSet &nonIntrinsicModulesWritten);
 
 private:
   SemanticsContext &context_;
@@ -46,6 +48,7 @@ private:
   std::string containsBuf_;
   // Tracks nested DEC structures and fields of that type
   UnorderedSymbolSet emittedDECStructures_, emittedDECFields_;
+  UnorderedSymbolSet usedNonIntrinsicModules_;
 
   llvm::raw_string_ostream needs_{needsBuf_};
   llvm::raw_string_ostream uses_{usesBuf_};
diff --git a/flang/lib/Semantics/unparse-with-symbols.cpp b/flang/lib/Semantics/unparse-with-symbols.cpp
index 67016e8..c451f885 100644
--- a/flang/lib/Semantics/unparse-with-symbols.cpp
+++ b/flang/lib/Semantics/unparse-with-symbols.cpp
@@ -7,6 +7,7 @@
 //===----------------------------------------------------------------------===//
 
 #include "flang/Semantics/unparse-with-symbols.h"
+#include "mod-file.h"
 #include "flang/Parser/parse-tree-visitor.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Parser/unparse.h"
@@ -98,4 +99,41 @@ void UnparseWithSymbols(llvm::raw_ostream &out, const parser::Program &program,
           int indent) { visitor.PrintSymbols(location, out, indent); }};
   parser::Unparse(out, program, encoding, false, true, &preStatement);
 }
+
+// UnparseWithModules()
+
+class UsedModuleVisitor {
+public:
+  UnorderedSymbolSet &modulesUsed() { return modulesUsed_; }
+  UnorderedSymbolSet &modulesDefined() { return modulesDefined_; }
+  template <typename T> bool Pre(const T &) { return true; }
+  template <typename T> void Post(const T &) {}
+  void Post(const parser::ModuleStmt &module) {
+    if (module.v.symbol) {
+      modulesDefined_.insert(*module.v.symbol);
+    }
+  }
+  void Post(const parser::UseStmt &use) {
+    if (use.moduleName.symbol) {
+      modulesUsed_.insert(*use.moduleName.symbol);
+    }
+  }
+
+private:
+  UnorderedSymbolSet modulesUsed_;
+  UnorderedSymbolSet modulesDefined_;
+};
+
+void UnparseWithModules(llvm::raw_ostream &out, SemanticsContext &context,
+    const parser::Program &program, parser::Encoding encoding) {
+  UsedModuleVisitor visitor;
+  parser::Walk(program, visitor);
+  UnorderedSymbolSet nonIntrinsicModulesWritten{
+      std::move(visitor.modulesDefined())};
+  ModFileWriter writer{context};
+  for (SymbolRef moduleRef : visitor.modulesUsed()) {
+    writer.WriteClosure(out, *moduleRef, nonIntrinsicModulesWritten);
+  }
+  parser::Unparse(out, program, encoding, false, true);
+}
 } // namespace Fortran::semantics
diff --git a/flang/test/Driver/unparse-with-modules.f90 b/flang/test/Driver/unparse-with-modules.f90
new file mode 100644
index 0000000..53997f7
--- /dev/null
+++ b/flang/test/Driver/unparse-with-modules.f90
@@ -0,0 +1,34 @@
+! RUN: %flang_fc1 -I %S/Inputs/module-dir -fdebug-unparse-with-modules %s | FileCheck %s
+module m1
+  use iso_fortran_env
+  use BasicTestModuleTwo
+  implicit none
+  type(t2) y
+  real(real32) x
+end
+
+program test
+  use m1
+  use BasicTestModuleTwo
+  implicit none
+  x = 123.
+  y = t2()
+end
+
+!CHECK-NOT: module iso_fortran_env
+!CHECK: module basictestmoduletwo
+!CHECK: type::t2
+!CHECK: end type
+!CHECK: end
+!CHECK: module m1
+!CHECK:  use :: iso_fortran_env
+!CHECK:  implicit none
+!CHECK:  real(kind=real32) x
+!CHECK: end module
+!CHECK: program test
+!CHECK:  use :: m1
+!CHECK:  use :: basictestmoduletwo
+!CHECK:  implicit none
+!CHECK:  x = 123.
+!CHECK:  y = t2()
+!CHECK: end program