commit de59858f16b4ea90c3e72104c2afddc47e9eef9f
author peter klausler <pklausler@nvidia.com> Wed Sep 15 17:25:15 2021 -0700
committer Copybara-Service <copybara-worker@google.com> Fri Sep 17 11:20:35 2021 -0700
tree fcca99007889e39b3bfd6df09da4d940549a9cd7
parent 7ceeb7193d7563a43fbf89bfdd008aa51ca193cb

[flang] Enforce specification function rules on callee, not call

A function can't be a specification function if it has a dummy procedure
argument, even if it's optional and unused.  So don't check the reference
for actual procedure arguments, but rather the characteristics of the
function.

Differential Revision: https://reviews.llvm.org/D109935

GitOrigin-RevId: 338f21a4bd6b43d9a2eb00929d24cefeb0ccf581

lib/Evaluate/check-expression.cpp

diff --git a/lib/Evaluate/check-expression.cpp b/lib/Evaluate/check-expression.cpp
index 570aad6..cb910ca 100644
--- a/lib/Evaluate/check-expression.cpp
+++ b/lib/Evaluate/check-expression.cpp
@@ -460,9 +460,6 @@
       : Base{*this}, scope_{s}, context_{context} {}
   using Base::operator();
 
-  Result operator()(const ProcedureDesignator &) const {
-    return "dummy procedure argument";
-  }
   Result operator()(const CoarrayRef &) const { return "coindexed reference"; }
 
   Result operator()(const semantics::Symbol &symbol) const {
@@ -541,6 +538,20 @@
             "' not allowed for derived type components or type parameter"
             " values";
       }
+      if (auto procChars{
+              characteristics::Procedure::Characterize(x.proc(), context_)}) {
+        const auto iter{std::find_if(procChars->dummyArguments.begin(),
+            procChars->dummyArguments.end(),
+            [](const characteristics::DummyArgument &dummy) {
+              return std::holds_alternative<characteristics::DummyProcedure>(
+                  dummy.u);
+            })};
+        if (iter != procChars->dummyArguments.end()) {
+          return "reference to function '"s + ultimate.name().ToString() +
+              "' with dummy procedure argument '" + iter->name + '\'';
+        }
+      }
+      // References to internal functions are caught in expression semantics.
       // TODO: other checks for standard module procedures
     } else {
       const SpecificIntrinsic &intrin{DEREF(x.proc().GetSpecificIntrinsic())};

test/Semantics/expr-errors02.f90

diff --git a/test/Semantics/expr-errors02.f90 b/test/Semantics/expr-errors02.f90
index 8d72cb6..5349e65 100644
--- a/test/Semantics/expr-errors02.f90
+++ b/test/Semantics/expr-errors02.f90
@@ -15,6 +15,7 @@
     pure integer function hasProcArg(p)
       import realfunc
       procedure(realfunc) :: p
+      optional :: p
     end function
   end interface
   integer :: coarray[*]
@@ -37,8 +38,8 @@
     integer, intent(in), optional :: optional
     !ERROR: Invalid specification expression: reference to OPTIONAL dummy argument 'optional'
     type(t(optional)) :: x5
-    !ERROR: Invalid specification expression: dummy procedure argument
-    type(t(hasProcArg(realfunc))) :: x6
+    !ERROR: Invalid specification expression: reference to function 'hasprocarg' with dummy procedure argument 'p'
+    type(t(hasProcArg())) :: x6
     !ERROR: Invalid specification expression: coindexed reference
     type(t(coarray[1])) :: x7
     type(t(kind(foo()))) :: x101 ! ok