[flang] Accept and ignore compiler directives between internal subpro… (#89810)

…grams

The parser only recognizes compiler directives that appear within
internal / module subprograms, not those that might appear between them.
Extend to allow them between subprograms as well.

1 files changed, 58 insertions, 28 deletions

diff --git a/flang/lib/Semantics/program-tree.cpp b/flang/lib/Semantics/program-tree.cpp
index bf773f3..13c85c1 100644
--- a/flang/lib/Semantics/program-tree.cpp
+++ b/flang/lib/Semantics/program-tree.cpp
@@ -10,6 +10,7 @@
 #include "flang/Common/idioms.h"
 #include "flang/Parser/char-block.h"
 #include "flang/Semantics/scope.h"
+#include "flang/Semantics/semantics.h"
 
 namespace Fortran::semantics {
 
@@ -76,7 +77,8 @@ static void GetGenerics(
 }
 
 template <typename T>
-static ProgramTree BuildSubprogramTree(const parser::Name &name, const T &x) {
+static ProgramTree BuildSubprogramTree(
+    const parser::Name &name, SemanticsContext &context, const T &x) {
   const auto &spec{std::get<parser::SpecificationPart>(x.t)};
   const auto &exec{std::get<parser::ExecutionPart>(x.t)};
   const auto &subps{
@@ -89,7 +91,11 @@ static ProgramTree BuildSubprogramTree(const parser::Name &name, const T &x) {
     for (const auto &subp :
         std::get<std::list<parser::InternalSubprogram>>(subps->t)) {
       common::visit(
-          [&](const auto &y) { node.AddChild(ProgramTree::Build(y.value())); },
+          [&](const auto &y) {
+            if (auto child{ProgramTree::Build(y.value(), context)}) {
+              node.AddChild(std::move(*child));
+            }
+          },
           subp.u);
     }
   }
@@ -97,13 +103,14 @@ static ProgramTree BuildSubprogramTree(const parser::Name &name, const T &x) {
 }
 
 static ProgramTree BuildSubprogramTree(
-    const parser::Name &name, const parser::BlockData &x) {
+    const parser::Name &name, SemanticsContext &, const parser::BlockData &x) {
   const auto &spec{std::get<parser::SpecificationPart>(x.t)};
   return ProgramTree{name, spec};
 }
 
 template <typename T>
-static ProgramTree BuildModuleTree(const parser::Name &name, const T &x) {
+static ProgramTree BuildModuleTree(
+    const parser::Name &name, SemanticsContext &context, const T &x) {
   const auto &spec{std::get<parser::SpecificationPart>(x.t)};
   const auto &subps{std::get<std::optional<parser::ModuleSubprogramPart>>(x.t)};
   ProgramTree node{name, spec};
@@ -112,28 +119,42 @@ static ProgramTree BuildModuleTree(const parser::Name &name, const T &x) {
     for (const auto &subp :
         std::get<std::list<parser::ModuleSubprogram>>(subps->t)) {
       common::visit(
-          [&](const auto &y) { node.AddChild(ProgramTree::Build(y.value())); },
+          [&](const auto &y) {
+            if (auto child{ProgramTree::Build(y.value(), context)}) {
+              node.AddChild(std::move(*child));
+            }
+          },
           subp.u);
     }
   }
   return node;
 }
 
-ProgramTree ProgramTree::Build(const parser::ProgramUnit &x) {
-  return common::visit([](const auto &y) { return Build(y.value()); }, x.u);
+ProgramTree ProgramTree::Build(
+    const parser::ProgramUnit &x, SemanticsContext &context) {
+  return common::visit(
+      [&](const auto &y) {
+        auto node{Build(y.value(), context)};
+        CHECK(node.has_value());
+        return std::move(*node);
+      },
+      x.u);
 }
 
-ProgramTree ProgramTree::Build(const parser::MainProgram &x) {
+std::optional<ProgramTree> ProgramTree::Build(
+    const parser::MainProgram &x, SemanticsContext &context) {
   const auto &stmt{
       std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(x.t)};
   const auto &end{std::get<parser::Statement<parser::EndProgramStmt>>(x.t)};
   static parser::Name emptyName;
-  auto result{stmt ? BuildSubprogramTree(stmt->statement.v, x).set_stmt(*stmt)
-                   : BuildSubprogramTree(emptyName, x)};
-  return result.set_endStmt(end);
+  auto result{stmt
+          ? BuildSubprogramTree(stmt->statement.v, context, x).set_stmt(*stmt)
+          : BuildSubprogramTree(emptyName, context, x)};
+  return std::move(result.set_endStmt(end));
 }
 
-ProgramTree ProgramTree::Build(const parser::FunctionSubprogram &x) {
+std::optional<ProgramTree> ProgramTree::Build(
+    const parser::FunctionSubprogram &x, SemanticsContext &context) {
   const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(x.t)};
   const auto &end{std::get<parser::Statement<parser::EndFunctionStmt>>(x.t)};
   const auto &name{std::get<parser::Name>(stmt.statement.t)};
@@ -144,13 +165,14 @@ ProgramTree ProgramTree::Build(const parser::FunctionSubprogram &x) {
       bindingSpec = &*suffix->binding;
     }
   }
-  return BuildSubprogramTree(name, x)
+  return BuildSubprogramTree(name, context, x)
       .set_stmt(stmt)
       .set_endStmt(end)
       .set_bindingSpec(bindingSpec);
 }
 
-ProgramTree ProgramTree::Build(const parser::SubroutineSubprogram &x) {
+std::optional<ProgramTree> ProgramTree::Build(
+    const parser::SubroutineSubprogram &x, SemanticsContext &context) {
   const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)};
   const auto &end{std::get<parser::Statement<parser::EndSubroutineStmt>>(x.t)};
   const auto &name{std::get<parser::Name>(stmt.statement.t)};
@@ -159,48 +181,56 @@ ProgramTree ProgramTree::Build(const parser::SubroutineSubprogram &x) {
           stmt.statement.t)}) {
     bindingSpec = &*binding;
   }
-  return BuildSubprogramTree(name, x)
+  return BuildSubprogramTree(name, context, x)
       .set_stmt(stmt)
       .set_endStmt(end)
       .set_bindingSpec(bindingSpec);
 }
 
-ProgramTree ProgramTree::Build(const parser::SeparateModuleSubprogram &x) {
+std::optional<ProgramTree> ProgramTree::Build(
+    const parser::SeparateModuleSubprogram &x, SemanticsContext &context) {
   const auto &stmt{std::get<parser::Statement<parser::MpSubprogramStmt>>(x.t)};
   const auto &end{
       std::get<parser::Statement<parser::EndMpSubprogramStmt>>(x.t)};
   const auto &name{stmt.statement.v};
-  return BuildSubprogramTree(name, x).set_stmt(stmt).set_endStmt(end);
+  return BuildSubprogramTree(name, context, x).set_stmt(stmt).set_endStmt(end);
 }
 
-ProgramTree ProgramTree::Build(const parser::Module &x) {
+std::optional<ProgramTree> ProgramTree::Build(
+    const parser::Module &x, SemanticsContext &context) {
   const auto &stmt{std::get<parser::Statement<parser::ModuleStmt>>(x.t)};
   const auto &end{std::get<parser::Statement<parser::EndModuleStmt>>(x.t)};
   const auto &name{stmt.statement.v};
-  return BuildModuleTree(name, x).set_stmt(stmt).set_endStmt(end);
+  return BuildModuleTree(name, context, x).set_stmt(stmt).set_endStmt(end);
 }
 
-ProgramTree ProgramTree::Build(const parser::Submodule &x) {
+std::optional<ProgramTree> ProgramTree::Build(
+    const parser::Submodule &x, SemanticsContext &context) {
   const auto &stmt{std::get<parser::Statement<parser::SubmoduleStmt>>(x.t)};
   const auto &end{std::get<parser::Statement<parser::EndSubmoduleStmt>>(x.t)};
   const auto &name{std::get<parser::Name>(stmt.statement.t)};
-  return BuildModuleTree(name, x).set_stmt(stmt).set_endStmt(end);
+  return BuildModuleTree(name, context, x).set_stmt(stmt).set_endStmt(end);
 }
 
-ProgramTree ProgramTree::Build(const parser::BlockData &x) {
+std::optional<ProgramTree> ProgramTree::Build(
+    const parser::BlockData &x, SemanticsContext &context) {
   const auto &stmt{std::get<parser::Statement<parser::BlockDataStmt>>(x.t)};
   const auto &end{std::get<parser::Statement<parser::EndBlockDataStmt>>(x.t)};
   static parser::Name emptyName;
-  auto result{stmt.statement.v ? BuildSubprogramTree(*stmt.statement.v, x)
-                               : BuildSubprogramTree(emptyName, x)};
-  return result.set_stmt(stmt).set_endStmt(end);
+  auto result{stmt.statement.v
+          ? BuildSubprogramTree(*stmt.statement.v, context, x)
+          : BuildSubprogramTree(emptyName, context, x)};
+  return std::move(result.set_stmt(stmt).set_endStmt(end));
 }
 
-ProgramTree ProgramTree::Build(const parser::CompilerDirective &) {
-  DIE("ProgramTree::Build() called for CompilerDirective");
+std::optional<ProgramTree> ProgramTree::Build(
+    const parser::CompilerDirective &x, SemanticsContext &context) {
+  context.Say(x.source, "Compiler directive ignored here"_warn_en_US);
+  return std::nullopt;
 }
 
-ProgramTree ProgramTree::Build(const parser::OpenACCRoutineConstruct &) {
+std::optional<ProgramTree> ProgramTree::Build(
+    const parser::OpenACCRoutineConstruct &, SemanticsContext &) {
   DIE("ProgramTree::Build() called for OpenACCRoutineConstruct");
 }