[flang] Rewrite function calls to array element references

parse-tree.h, parse-tree.cc:
Add FunctionReference::ConvertToArrayElementRef() to convert a function
reference to an array element reference.
Factor out MakeArrayElementRef() to use in ConvertToArrayElementRef()
and also in converting statement functions to array element assignments.

resolve-names.cc:
Recognize references to functions and subroutines and add symbols for them.
Detect declaration conflicts from these and check `IMPLICIT NONE(EXTERNAL)`.

rewrite-parse-tree.cc:
Find function references that need to be converted and rewrite them.

Original-commit: flang-compiler/f18@e5a1e0aaeffe8de92b1ecb67890ffa463cd6a43a
Reviewed-on: https://github.com/flang-compiler/f18/pull/65

diff --git a/flang/lib/parser/parse-tree.cc b/flang/lib/parser/parse-tree.cc
index 8eaa82dc8eeb55f07bac6de811c9fe85e04c6e22..c6e457f0c13974e6ad44a8f7ebda2c7f86a28cda 100644 (file)
--- a/flang/lib/parser/parse-tree.cc
+++ b/flang/lib/parser/parse-tree.cc
@@ -47,19 +47,53 @@ Expr::Expr(Designator &&x) : u{Indirection<Designator>(std::move(x))} {}
 Expr::Expr(FunctionReference &&x)
   : u{Indirection<FunctionReference>(std::move(x))} {}
 
+static Designator MakeArrayElementRef(Name &name, std::list<Expr> &subscripts) {
+  ArrayElement arrayElement{name, std::list<SectionSubscript>{}};
+  for (Expr &expr : subscripts) {
+    arrayElement.subscripts.push_back(
+        SectionSubscript{Scalar{Integer{Indirection{std::move(expr)}}}});
+  }
+  return Designator{DataRef{Indirection{std::move(arrayElement)}}};
+}
+
+Designator FunctionReference::ConvertToArrayElementRef() {
+  auto &name = std::get<parser::Name>(std::get<ProcedureDesignator>(v.t).u);
+  std::list<Expr> args;
+  for (auto &arg : std::get<std::list<ActualArgSpec>>(v.t)) {
+    std::visit(
+        visitors{
+            [&](Indirection<Expr> &y) { args.push_back(std::move(*y)); },
+            [&](Indirection<Variable> &y) {
+              args.push_back(std::visit(
+                  visitors{
+                      [&](Indirection<Designator> &z) {
+                        return Expr{std::move(*z)};
+                      },
+                      [&](Indirection<FunctionReference> &z) {
+                        return Expr{std::move(*z)};
+                      },
+                  },
+                  y->u));
+            },
+            [&](auto &) { CHECK(!"unexpected kind of ActualArg"); },
+        },
+        std::get<ActualArg>(arg.t).u);
+  }
+  return MakeArrayElementRef(name, args);
+}
+
 // R1544 stmt-function-stmt
 // Convert this stmt-function-stmt to an array element assignment statement.
 Statement<ActionStmt> StmtFunctionStmt::ConvertToAssignment() {
   auto &funcName = std::get<Name>(t);
   auto &funcArgs = std::get<std::list<Name>>(t);
   auto &funcExpr = std::get<Scalar<Expr>>(t).thing;
-  ArrayElement arrayElement{funcName, std::list<SectionSubscript>{}};
+  std::list<Expr> subscripts;
   for (Name &arg : funcArgs) {
-    arrayElement.subscripts.push_back(SectionSubscript{
-        Scalar{Integer{Indirection{Expr{Indirection{Designator{arg}}}}}}});
+    subscripts.push_back(Expr{Indirection{Designator{arg}}});
   }
-  auto &&variable = Variable{
-      Indirection{Designator{DataRef{Indirection{std::move(arrayElement)}}}}};
+  auto &&variable =
+      Variable{Indirection{MakeArrayElementRef(funcName, subscripts)}};
   return Statement{std::nullopt,
       ActionStmt{Indirection{
           AssignmentStmt{std::move(variable), std::move(funcExpr)}}}};

diff --git a/flang/lib/parser/parse-tree.h b/flang/lib/parser/parse-tree.h
index d0a26434c89b8acb01614bab55638c8581408fb7..38d33f8de84993ebca57bba0157d17d484790a37 100644 (file)
--- a/flang/lib/parser/parse-tree.h
+++ b/flang/lib/parser/parse-tree.h
@@ -3057,7 +3057,11 @@ struct Call {
   TUPLE_CLASS_BOILERPLATE(Call);
   std::tuple<ProcedureDesignator, std::list<ActualArgSpec>> t;
 };
-WRAPPER_CLASS(FunctionReference, Call);
+
+struct FunctionReference {
+  WRAPPER_CLASS_BOILERPLATE(FunctionReference, Call);
+  Designator ConvertToArrayElementRef();
+};
 
 // R1521 call-stmt -> CALL procedure-designator [( [actual-arg-spec-list] )]
 WRAPPER_CLASS(CallStmt, Call);

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index fda0c75afbe855b604379d58f11b1325a4451b16..f02ca6870a8fb48682d17a7fbf63909f3a90f3ed 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -179,6 +179,9 @@ public:
   bool isImplicitNoneType() const {
     return implicitRules().isImplicitNoneType();
   }
+  bool isImplicitNoneExternal() const {
+    return implicitRules().isImplicitNoneExternal();
+  }
 
 protected:
   void PushScope();
@@ -392,6 +395,28 @@ public:
     }
   }
 
+  void Post(const parser::ProcedureDesignator &x) {
+    if (const auto *name = std::get_if<parser::Name>(&x.u)) {
+      Symbol &symbol{MakeSymbol(*name)};
+      if (symbol.has<UnknownDetails>()) {
+        if (isImplicitNoneExternal() && !symbol.attrs().test(Attr::EXTERNAL)) {
+          Say(*name,
+              "'%s' is an external procedure without the EXTERNAL"
+              " attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US);
+        }
+        symbol.attrs().set(Attr::EXTERNAL);
+        symbol.set_details(SubprogramDetails{});
+      } else if (!symbol.has<SubprogramDetails>()) {
+        auto *details = symbol.detailsIf<EntityDetails>();
+        if (!details || !details->isArray()) {
+          Say(*name,
+              "Use of '%s' as a procedure conflicts with its declaration"_err_en_US);
+          Say(symbol.name(), "Declaration of '%s'"_en_US);
+        }
+      }
+    }
+  }
+
 private:
   // Stack of containing scopes; memory referenced is owned by parent scopes
   std::stack<Scope *, std::list<Scope *>> scopes_;
@@ -421,7 +446,9 @@ private:
       const auto pair = CurrScope().try_emplace(name.source, attrs, details);
       CHECK(pair.second);  // name was not found, so must be able to add
       return pair.first->second;
-    } else if (symbol.has<UnknownDetails>()) {
+    }
+    symbol.add_occurrence(name.source);
+    if (symbol.has<UnknownDetails>()) {
       // update the existing symbol
       symbol.attrs() |= attrs;
       symbol.set_details(details);
@@ -441,7 +468,7 @@ private:
   Symbol &MakeSymbol(const parser::Name &name, D &&details) {
     return MakeSymbol(name, Attrs(), details);
   }
-  Symbol &MakeSymbol(const parser::Name &name, Attrs attrs) {
+  Symbol &MakeSymbol(const parser::Name &name, Attrs attrs = Attrs{}) {
     return MakeSymbol(name, attrs, UnknownDetails());
   }
   void DeclareEntity(const parser::Name &, Attrs);
@@ -766,12 +793,6 @@ bool ImplicitRulesVisitor::HandleImplicitNone(
       case ImplicitNoneNameSpec::External:
         implicitRules().set_isImplicitNoneExternal(true);
         ++sawExternal;
-        // TODO:
-        // C894 If IMPLICIT NONE with an implicit-none-spec of EXTERNAL
-        // appears within a scoping unit, the  name of an external or dummy
-        // procedure in that scoping unit or in a contained subprogram or
-        // BLOCK  construct shall have an explicit interface or be explicitly
-        // declared to have the EXTERNAL attribute.
         break;
       case ImplicitNoneNameSpec::Type:
         prevImplicitNoneType_ = currStmtSource();

diff --git a/flang/lib/semantics/rewrite-parse-tree.cc b/flang/lib/semantics/rewrite-parse-tree.cc
index 6eb526f1aa010380b31c0ff04191d8f74b5f0c20..7d80fd2d3f0f4a3a439598fcbcdd4669539743e4 100644 (file)
--- a/flang/lib/semantics/rewrite-parse-tree.cc
+++ b/flang/lib/semantics/rewrite-parse-tree.cc
@@ -62,9 +62,34 @@ public:
     return true;
   }
 
+  void Post(parser::Variable &x) {
+    ConvertFunctionRef(x);
+  }
+
+  void Post(parser::Expr &x) {
+    ConvertFunctionRef(x);
+  }
+
 private:
   const symbolMap &symbols_;
   std::list<stmtFuncType> stmtFuncsToConvert;
+
+  // For T = Variable or Expr, if x has a function reference that really
+  // should be an array element reference (i.e. the name occurs in an
+  // entity declaration, convert it.
+  template<typename T> void ConvertFunctionRef(T & x) {
+    auto *funcRef =
+        std::get_if<parser::Indirection<parser::FunctionReference>>(&x.u);
+    if (!funcRef) {
+      return;
+    }
+    parser::Name *name = std::get_if<parser::Name>(
+        &std::get<parser::ProcedureDesignator>((*funcRef)->v.t).u);
+    if (!name || !name->symbol || !name->symbol->has<EntityDetails>()) {
+      return;
+    }
+    x.u = parser::Indirection{(*funcRef)->ConvertToArrayElementRef()};
+  }
 };
 
 static void CollectSymbols(Scope &scope, symbolMap &symbols) {

diff --git a/flang/test/semantics/implicit07.f90 b/flang/test/semantics/implicit07.f90
new file mode 100644 (file)
index 0000000..9b112bf
--- /dev/null
+++ b/flang/test/semantics/implicit07.f90
@@ -0,0 +1,6 @@
+implicit none(external)
+external x
+call x
+!ERROR: 'y' is an external procedure without the EXTERNAL attribute in a scope with IMPLICIT NONE(EXTERNAL)
+call y
+end

diff --git a/flang/test/semantics/resolve09.f90 b/flang/test/semantics/resolve09.f90
new file mode 100644 (file)
index 0000000..97484e9
--- /dev/null
+++ b/flang/test/semantics/resolve09.f90
@@ -0,0 +1,5 @@
+integer :: y
+call x
+!ERROR: Use of 'y' as a procedure conflicts with its declaration
+call y
+end