[flang] Fix CheckSpecificationExpr handling of associated names

[klausler]

Summary

Avoid a spurious error message about a dummy procedure reference
in a specification expression by restructuring the handling of
use-associated and host-associated symbols.

[PeteSteinfeld]

All builds, tests, and looks good.

[awarzynski]

Hi @klausler , thank you for working on this!

Sadly this is causing our public buildbots to fail:

• http://lab.llvm.org:8011/#/builders/33/builds/626
• http://lab.llvm.org:8011/#/builders/66/builds/440

I'm guessing that this patch wasn't tested with BUILD_SHARED_LIBS=ON? I always try to find and apply a fix for this kind of things, but in this case I'm struggling. IIUC, FortranSemantics is missing from the list of dependencies of libflangEvaluate:

index a2fdc10896b..bbe7857cfc5 100644
--- a/flang/lib/Evaluate/CMakeLists.txt
+++ b/flang/lib/Evaluate/CMakeLists.txt
@@ -42,6 +42,7 @@ add_flang_library(FortranEvaluate
   FortranCommon
   FortranDecimal
   FortranParser
+  FortranSemantics
   ${LIBPGMATH}

   LINK_COMPONENTS

However, that introduces a circular dependency that CMake rejects:

CMake Error: The inter-target dependency graph contains the following strongly connected component (cycle):
  "FortranEvaluate" of type SHARED_LIBRARY
    depends on "FortranSemantics" (weak)
  "FortranSemantics" of type SHARED_LIBRARY
    depends on "FortranEvaluate" (weak)
At least one of these targets is not a STATIC_LIBRARY.  Cyclic dependencies are allowed only among static libraries.

See here: https://gitlab.kitware.com/cmake/cmake/-/issues/17905

Perhaps I'm missing something obvious? I'm not really familiar with this codebase. I will revert this for now. It's a relatively small patch and hopefully that will not block anyone.

[tskeith]

Probably IsModule and IsSubmodule have to be made inline.

[awarzynski]

I think that the root cause of the build failure is the circular dependency: FortranSemantics <-> FortranEvaluate <-> FortranSemantics. Adding inline to IsModule and IsSubmodule fixes this particular build issue, but not the circular dependency.

[klausler]

In D91209#2388817, @tskeith wrote:

Probably IsModule and IsSubmodule have to be made inline.

I think that's the case; will do.

[klausler]

In D91209#2389115, @awarzynski wrote:

I think that the root cause of the build failure is the circular dependency: FortranSemantics <-> FortranEvaluate <-> FortranSemantics. Adding inline to IsModule and IsSubmodule fixes this particular build issue, but not the circular dependency.

We know. The long-term solution seems to be to refactor the representational aspects of Semantics -- i.e., scopes and symbols -- into their own library, but that's a big job that nobody has time for. For now, we restrict Evaluate to depend on the headers of Semantics but not its binary library. (The other solution would be to combine Evaluate back into Semantics, of course.)

flang/lib/Evaluate/check-expression.cpp

public:
   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 {
-    if (semantics::IsNamedConstant(symbol)) {
+    const auto &ultimate{symbol.GetUltimate()};
+    if (semantics::IsNamedConstant(ultimate) || ultimate.owner().IsModule() ||
+        ultimate.owner().IsSubmodule()) {
       return std::nullopt;
-    } else if (scope_.IsDerivedType() && IsVariableName(symbol)) { // C750, C754
+    } else if (scope_.IsDerivedType() &&
+        IsVariableName(ultimate)) { // C750, C754
       return "derived type component or type parameter value not allowed to "
              "reference variable '"s +
-          symbol.name().ToString() + "'";
-    } else if (IsDummy(symbol)) {
-      if (symbol.attrs().test(semantics::Attr::OPTIONAL)) {
+          ultimate.name().ToString() + "'";
+    } else if (IsDummy(ultimate)) {
+      if (ultimate.attrs().test(semantics::Attr::OPTIONAL)) {
         return "reference to OPTIONAL dummy argument '"s +
-            symbol.name().ToString() + "'";
-      } else if (symbol.attrs().test(semantics::Attr::INTENT_OUT)) {
+            ultimate.name().ToString() + "'";
+      } else if (ultimate.attrs().test(semantics::Attr::INTENT_OUT)) {
         return "reference to INTENT(OUT) dummy argument '"s +
-            symbol.name().ToString() + "'";
-      } else if (symbol.has<semantics::ObjectEntityDetails>()) {
+            ultimate.name().ToString() + "'";
+      } else if (ultimate.has<semantics::ObjectEntityDetails>()) {
         return std::nullopt;
       } else {
         return "dummy procedure argument";
       }
-    } else if (symbol.has<semantics::UseDetails>() ||
-        symbol.has<semantics::HostAssocDetails>() ||
-        symbol.owner().kind() == semantics::Scope::Kind::Module) {
-      return std::nullopt;
     } else if (const auto *object{
-                   symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
+                   ultimate.detailsIf<semantics::ObjectEntityDetails>()}) {
       // TODO: what about EQUIVALENCE with data in COMMON?
       // TODO: does this work for blank COMMON?
       if (object->commonBlock()) {
         return std::nullopt;
       }
     }
     for (const semantics::Scope *s{&scope_}; !s->IsGlobal();) {
       s = &s->parent();
-      if (s == &symbol.owner()) {
+      if (s == &ultimate.owner()) {
         return std::nullopt;
       }
     }
-    return "reference to local entity '"s + symbol.name().ToString() + "'";
+    return "reference to local entity '"s + ultimate.name().ToString() + "'";
   }
 
   Result operator()(const Component &x) const {
     // Don't look at the component symbol.
     return (*this)(x.base());
   }
   Result operator()(const DescriptorInquiry &) const {
     // Subtle: Uses of SIZE(), LBOUND(), &c. that are valid in specification

flang/test/Semantics/spec-expr.f90

 !   section subscript, substring starting point, substring ending point, and 
 !   type parameter value is a restricted expression
 subroutine s15()
   type :: dtype(param)
     integer, len :: param
     real, dimension((param + 2)) :: realField
   end type dtype
 end subroutine s15
+
+! Regression test: don't get confused by host association
+subroutine s16(n)
+  integer :: n
+ contains
+  subroutine inner(r)
+    real, dimension(n) :: r
+  end subroutine
+end subroutine s16