[flang] commit to switch branches

Some groundwork

Original-commit: flang-compiler/f18@64ebeb511c
Reviewed-on: https://github.com/flang-compiler/f18/pull/732
Tree-same-pre-rewrite: false

flang/lib/evaluate/call.h

@@ -37,6 +37,7 @@ class Component;
 class IntrinsicProcTable;
 }
 namespace Fortran::evaluate::characteristics {
+struct DummyArgument;
 struct Procedure;
 }
 
@@ -106,6 +107,8 @@ public:
   std::optional<parser::CharBlock> keyword;
   bool isAlternateReturn{false};  // when true, "value" is a label number
 
+  bool Matches(const characteristics::DummyArgument &) const;
+
   // TODO: Mark legacy %VAL and %REF arguments
 
 private:

flang/lib/semantics/check-io.h

@@ -12,8 +12,8 @@
 // See the License for the specific language governing permissions and
 // limitations under the License.
 
-#ifndef FORTRAN_SEMANTICS_IO_H_
-#define FORTRAN_SEMANTICS_IO_H_
+#ifndef FORTRAN_SEMANTICS_CHECK_IO_H_
+#define FORTRAN_SEMANTICS_CHECK_IO_H_
 
 #include "semantics.h"
 #include "tools.h"
@@ -141,4 +141,4 @@ private:
 };
 
 }
-#endif  // FORTRAN_SEMANTICS_IO_H_
+#endif  // FORTRAN_SEMANTICS_CHECK_IO_H_

flang/lib/semantics/expression.cc

@@ -1513,17 +1513,42 @@ std::optional<ActualArgument> ExpressionAnalyzer::AnalyzeActualArgument(
 
 MaybeExpr ExpressionAnalyzer::Analyze(
     const parser::FunctionReference &funcRef) {
+  return AnalyzeCall(funcRef.v, false);
+}
+
+void ExpressionAnalyzer::Analyze(const parser::CallStmt &call) {
+  AnalyzeCall(call.v, true);
+}
+
+MaybeExpr ExpressionAnalyzer::AnalyzeCall(
+    const parser::Call &call, bool isSubroutine) {
+  auto save{GetContextualMessages().SetLocation(call.source)};
+  if (auto arguments{AnalyzeArguments(call, isSubroutine)}) {
+    // TODO: map non-intrinsic generic procedure to specific procedure
+    if (std::optional<CalleeAndArguments> callee{Procedure(
+            std::get<parser::ProcedureDesignator>(call.t), *arguments)}) {
+      if (isSubroutine) {
+        // TODO
+      } else {
+        return MakeFunctionRef(std::move(*callee));
+      }
+    }
+  }
+  return std::nullopt;
+}
+
+std::optional<ActualArguments> ExpressionAnalyzer::AnalyzeArguments(
+    const parser::Call &call, bool isSubroutine) {
+  evaluate::ActualArguments arguments;
   // TODO: C1002: Allow a whole assumed-size array to appear if the dummy
   // argument would accept it.  Handle by special-casing the context
   // ActualArg -> Variable -> Designator.
   // TODO: Actual arguments that are procedures and procedure pointers need to
   // be detected and represented (they're not expressions).
   // TODO: C1534: Don't allow a "restricted" specific intrinsic to be passed.
-  auto save{GetContextualMessages().SetLocation(funcRef.v.source)};
-  ActualArguments arguments;
-  for (const auto &arg :
-      std::get<std::list<parser::ActualArgSpec>>(funcRef.v.t)) {
-    std::optional<ActualArgument> actual;
+  // TODO: map non-intrinsic generic procedure to specific procedure
+  for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
+    std::optional<evaluate::ActualArgument> actual;
     std::visit(
         common::visitors{
             [&](const common::Indirection<parser::Expr> &x) {
@@ -1532,7 +1557,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(
               actual = AnalyzeActualArgument(x.value());
             },
             [&](const parser::AltReturnSpec &) {
-              Say("alternate return specification may not appear on function reference"_err_en_US);
+              if (!isSubroutine) {
+                Say("alternate return specification may not appear on function reference"_err_en_US);
+              }
             },
             [&](const parser::ActualArg::PercentRef &) {
               Say("TODO: %REF() argument"_err_en_US);
@@ -1551,15 +1578,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(
       return std::nullopt;
     }
   }
-
-  // TODO: map non-intrinsic generic procedure to specific procedure
-  if (std::optional<CalleeAndArguments> callee{Procedure(
-          std::get<parser::ProcedureDesignator>(funcRef.v.t), arguments)}) {
-    if (MaybeExpr funcRef{MakeFunctionRef(std::move(*callee))}) {
-      return funcRef;
-    }
-  }
-  return std::nullopt;
+  return arguments;
 }
 
 // Unary operations
@@ -2152,8 +2171,18 @@ evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
   return analyzer.AnalyzeKindSelector(category, selector);
 }
 
+ExprChecker::ExprChecker(SemanticsContext &context) : context_{context} {}
+
 bool ExprChecker::Walk(const parser::Program &program) {
   parser::Walk(program, *this);
   return !context_.AnyFatalError();
 }
+
+CallChecker::CallChecker(SemanticsContext &context) : analyzer_{context} {}
+
+void CallChecker::Enter(const parser::CallStmt &call) {
+  analyzer_.Analyze(call);
+}
+
+void CallChecker::Leave(const parser::CallStmt &) {}
 }

flang/lib/semantics/expression.h

@@ -235,6 +235,8 @@ public:
   }
   MaybeExpr Analyze(const parser::StructureComponent &);
 
+  void Analyze(const parser::CallStmt &);
+
 protected:
   int IntegerTypeSpecKind(const parser::IntegerTypeSpec &);
 
@@ -317,6 +319,10 @@ private:
     ProcedureDesignator procedureDesignator;
     ActualArguments arguments;
   };
+
+  MaybeExpr AnalyzeCall(const parser::Call &, bool isSubroutine);
+  std::optional<ActualArguments> AnalyzeArguments(
+      const parser::Call &, bool isSubroutine);
   std::optional<CalleeAndArguments> Procedure(
       const parser::ProcedureDesignator &, ActualArguments &);
   bool EnforceTypeConstraint(parser::CharBlock, const MaybeExpr &, TypeCategory,
@@ -373,7 +379,7 @@ evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
 // decorated with typed representations for top-level expressions.
 class ExprChecker {
 public:
-  explicit ExprChecker(SemanticsContext &context) : context_{context} {}
+  explicit ExprChecker(SemanticsContext &);
 
   template<typename A> bool Pre(const A &) { return true; }
   template<typename A> void Post(const A &) {}
@@ -412,5 +418,18 @@ public:
 private:
   SemanticsContext &context_;
 };
+
+// Semantic analysis of all CALL statements in a parse tree.
+// (Function references are processed as primary expressions.)
+class CallChecker {
+public:
+  explicit CallChecker(SemanticsContext &);
+  void Enter(const parser::CallStmt &);
+  void Leave(const parser::CallStmt &);
+
+private:
+  evaluate::ExpressionAnalyzer analyzer_;
+};
+
 }  // namespace Fortran::semantics
 #endif  // FORTRAN_SEMANTICS_EXPRESSION_H_

flang/lib/semantics/semantics.cc

@@ -100,7 +100,7 @@ private:
 
 using StatementSemanticsPass1 = ExprChecker;
 using StatementSemanticsPass2 = SemanticsVisitor<AllocateChecker,
-    ArithmeticIfStmtChecker, AssignmentChecker, CoarrayChecker,
+    ArithmeticIfStmtChecker, AssignmentChecker, CallChecker, CoarrayChecker,
     DeallocateChecker, DoChecker, IfStmtChecker, IoChecker, NullifyChecker,
     OmpStructureChecker, ReturnStmtChecker, StopChecker>;