[flang] progress

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

flang/lib/evaluate/fold.cc

@@ -2584,22 +2584,25 @@ struct CheckSpecificationExprHelper
       } else if (symbol.attrs().test(semantics::Attr::INTENT_OUT)) {
         return Say("reference to INTENT(OUT) dummy argument '" +
             symbol.name().ToString() + "'");
-      } else {
+      } else if (symbol.has<semantics::ObjectEntityDetails>()) {
         return true;
+      } else {
+        return Say("dummy procedure argument");
       }
+    } else if (symbol.has<semantics::UseDetails>() ||
+        symbol.has<semantics::HostAssocDetails>()) {
+      return true;
     } else if (const auto *object{
                    symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
       // TODO: what about EQUIVALENCE with data in COMMON?
       // TODO: does this work for blank COMMON?
-      return object->commonBlock() != nullptr;
+      if (object->commonBlock() != nullptr) {
-    } else if (symbol.has<semantics::UseDetails>() ||
+        return true;
-        symbol.has<semantics::HostAssocDetails>()) {
+      }
-      return true;
-    } else {
-      return Say(
-          "reference to local object '" + symbol.name().ToString() + "'");
     }
+    return Say("reference to local entity '" + symbol.name().ToString() + "'");
   }
+
   bool operator()(const Component &x) { return (*this)(x.base()); }
   bool operator()(const ArrayRef &x) {
     return (*this)(x.base()) && (*this)(x.subscript());

flang/lib/semantics/expression.cc

@@ -1503,6 +1503,13 @@ auto ExpressionAnalyzer::Procedure(const parser::ProcedureDesignator &pd,
                 return std::nullopt;
               }
             }
+            if (symbol.has<semantics::SubprogramNameDetails>()) {
+              // Forward reference to internal function in specification
+              // expression
+              Say("Cannot call function '%s' in this context"_err_en_US,
+                  symbol.name());
+              return std::nullopt;
+            }
             if (const auto *scope{symbol.scope()}) {
               if (scope->sourceRange().Contains(n.source)) {
                 if (symbol.attrs().test(

flang/test/semantics/expr-errors02.f90

@@ -16,12 +16,18 @@
 
 module m
   type :: t(n)
-    integer, len :: n
+    integer, len :: n = 1
     character(len=n) :: c
   end type
   interface
     integer function foo()
     end function
+    pure integer function hasProcArg(p)
+      procedure(cos) :: p
+    end function
+    real function realfunc(x)
+      real, intent(in) :: x
+    end function
   end interface
   integer :: coarray[*]
  contains
@@ -29,9 +35,9 @@ module m
     !ERROR: The expression (foo()) cannot be used as a specification expression (reference to impure function 'foo')
     type(t(foo())) :: x1
     integer :: local
-    !ERROR: The expression (local) cannot be used as a specification expression (reference to local object 'local')
+    !ERROR: The expression (local) cannot be used as a specification expression (reference to local entity 'local')
     type(t(local)) :: x2
-    !ERROR: The expression (internal()) cannot be used as a specification expression (reference to internal function 'internal')
+    !ERROR: Cannot call function 'internal' in this context
     type(t(internal(0))) :: x3
     integer, intent(out) :: out
     !ERROR: The expression (out) cannot be used as a specification expression (reference to INTENT(OUT) dummy argument 'out')
@@ -39,19 +45,20 @@ module m
     integer, intent(in), optional :: optional
     !ERROR: The expression (optional) cannot be used as a specification expression (reference to OPTIONAL dummy argument 'optional')
     type(t(optional)) :: x5
-    !ERROR: The expression (hasprocarg(sin)) cannot be used as a specification expression (dummy procedure argument)
+    !ERROR: The expression (hasprocarg(realfunc)) cannot be used as a specification expression (dummy procedure argument)
-    type(t(hasProcArg(sin))) :: x6
+    type(t(hasProcArg(realfunc))) :: x6
     !ERROR: The expression (coarray[1_8]) cannot be used as a specification expression (coindexed reference)
     type(t(coarray[1])) :: x7
     type(t(kind(foo()))) :: x101 ! ok
+    type(t(modulefunc(0))) :: x102 ! ok?
    contains
     pure integer function internal(n)
       integer, value :: n
       internal = n
     end function
   end subroutine
-  pure integer function hasProcArg(p)
+  pure integer function modulefunc(n)
-    procedure(cos) :: p
+    integer, value :: n
-    hasProcArg = 0
+    modulefunc = n
   end function
 end module