[flang] Avoid bogus error for specification expression

When a scope's symbol has characteriztics whose specification
expressions depend on other non-constant symbols in the same scope,
f18 rightfully emits an error.  However, in the case of usage in
specification expressions involving host association, the program is not
invalid.  This can arise, for example, in the case of an internal
function whose result's attributes use host-associated variables.

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

3 files changed, 14 insertions, 7 deletions

diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 1bb33b62151e..64b118a54aa7 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -526,18 +526,14 @@ public:
       } else {
         return "dummy procedure argument";
       }
+    } else if (&symbol.owner() != &scope_ || &ultimate.owner() != &scope_) {
+      return std::nullopt; // host association is in play
     } else if (const auto *object{
                    ultimate.detailsIf<semantics::ObjectEntityDetails>()}) {
       if (object->commonBlock()) {
         return std::nullopt;
       }
     }
-    for (const semantics::Scope *s{&scope_}; !s->IsGlobal();) {
-      s = &s->parent();
-      if (s == &ultimate.owner()) {
-        return std::nullopt;
-      }
-    }
     return "reference to local entity '"s + ultimate.name().ToString() + "'";
   }
 
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index dcb8cd383403..fdbbcaba55ae 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -34,7 +34,6 @@ using characteristics::Procedure;
 class CheckHelper {
 public:
   explicit CheckHelper(SemanticsContext &c) : context_{c} {}
-  CheckHelper(SemanticsContext &c, const Scope &s) : context_{c}, scope_{&s} {}
 
   SemanticsContext &context() { return context_; }
   void Check() { Check(context_.globalScope()); }
diff --git a/flang/test/Semantics/resolve69.f90 b/flang/test/Semantics/resolve69.f90
index e3f00e2bb27a..ee3e21a6a870 100644
--- a/flang/test/Semantics/resolve69.f90
+++ b/flang/test/Semantics/resolve69.f90
@@ -64,3 +64,15 @@ Program d5
   line%value = 'ok'
   Print *,Trim(line%value)
 End Program
+
+!Not errors.
+subroutine outer
+  integer n
+ contains
+  character(n) function inner1()
+    inner1 = ''
+  end function inner1
+  function inner2()
+    real inner2(n)
+  end function inner2
+end subroutine outer