From c36f7d916a44169a0f55ce7bd87a0b9cf1f8590b Mon Sep 17 00:00:00 2001
From: peter klausler <pklausler@nvidia.com>
Date: Tue, 17 Sep 2019 17:08:32 -0700
Subject: [PATCH] [flang] progress

Original-commit: flang-compiler/f18@b5e3e709cb0f9ee61124af3422372b01132e07be
Reviewed-on: https://github.com/flang-compiler/f18/pull/755
Tree-same-pre-rewrite: false
---
 flang/lib/evaluate/fold.cc             | 19 +++++++++++--------
 flang/lib/semantics/expression.cc      |  7 +++++++
 flang/test/semantics/expr-errors02.f90 | 23 +++++++++++++++--------
 3 files changed, 33 insertions(+), 16 deletions(-)

diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc
index 7d93a0349289..dde0929761f5 100644
--- a/flang/lib/evaluate/fold.cc
+++ b/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;
-    } else if (symbol.has<semantics::UseDetails>() ||
-        symbol.has<semantics::HostAssocDetails>()) {
-      return true;
-    } else {
-      return Say(
-          "reference to local object '" + symbol.name().ToString() + "'");
+      if (object->commonBlock() != nullptr) {
+        return true;
+      }
     }
+    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());
diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc
index 29b72b314ceb..3bb494c93c9d 100644
--- a/flang/lib/semantics/expression.cc
+++ b/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(
diff --git a/flang/test/semantics/expr-errors02.f90 b/flang/test/semantics/expr-errors02.f90
index e3d1c7525f0f..ddec70b30607 100644
--- a/flang/test/semantics/expr-errors02.f90
+++ b/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)
-    type(t(hasProcArg(sin))) :: x6
+    !ERROR: The expression (hasprocarg(realfunc)) cannot be used as a specification expression (dummy procedure argument)
+    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)
-    procedure(cos) :: p
-    hasProcArg = 0
+  pure integer function modulefunc(n)
+    integer, value :: n
+    modulefunc = n
   end function
 end module