[flang] Create HostAssocDetails symbols when needed for mis-parsed ArrayRef

[jeanPerier]

Summary

Name resolution is always creating symbols with HostAssocDetails
for host variable names inside internal procedures. This helps lowering
identifying and dealing with such variables inside internal procedures.

However, the case where the variable appears in an ArrayRef mis-parsed
as a FunctionRef goes through a different name resolution path that did
not create such HostAssocDetails when needed. Pointer assignment RHS
are also skipping this path.

Add the logic to create HostAssocDetails for host symbols inisde internal
procedures that appear in mis-parsed ArrayRef or in pointer assignment RHS.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/lib/Semantics/resolve-names.cpp

6598

This should be "name is known" rather than "name is know".

[jeanPerier]

Fix typo in comment.

flang/lib/Semantics/resolve-names.cpp

protected:
   // Each of these returns a pointer to a resolved Name (i.e. with symbol)
   // or nullptr in case of error.
   const parser::Name *ResolveStructureComponent(
       const parser::StructureComponent &);
   const parser::Name *ResolveDataRef(const parser::DataRef &);
   const parser::Name *ResolveName(const parser::Name &);
   bool PassesSharedLocalityChecks(const parser::Name &name, Symbol &symbol);
   Symbol *NoteInterfaceName(const parser::Name &);
+  bool IsUplevelReference(const Symbol &);
 
 private:
   // The attribute corresponding to the statement containing an ObjectDecl
   std::optional<Attr> objectDeclAttr_;
   // Info about current character type while walking DeclTypeSpec.
   // Also captures any "*length" specifier on an individual declaration.
   struct {
     std::optional<ParamValue> length;
private:
   ParamValue GetParamValue(
       const parser::TypeParamValue &, common::TypeParamAttr attr);
   void CheckCommonBlockDerivedType(const SourceName &, const Symbol &);
   std::optional<MessageFixedText> CheckSaveAttr(const Symbol &);
   Attrs HandleSaveName(const SourceName &, Attrs);
   void AddSaveName(std::set<SourceName> &, const SourceName &);
   void SetSaveAttr(Symbol &);
   bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &);
-  bool IsUplevelReference(const Symbol &);
   const parser::Name *FindComponent(const parser::Name *, const parser::Name &);
   void Initialization(const parser::Name &, const parser::Initialization &,
       bool inComponentDecl);
   bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol);
   bool CheckForHostAssociatedImplicit(const parser::Name &);
 
   // Declare an object or procedure entity.
   // T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails
if (!symbol) {
     if (!SetProcFlag(name, *symbol, flag)) {
       return; // reported error
     }
     CheckImplicitNoneExternal(name.source, *symbol);
     if (symbol->has<SubprogramDetails>() &&
         symbol->attrs().test(Attr::ABSTRACT)) {
       Say(name, "Abstract interface '%s' may not be called"_err_en_US);
     } else if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||
-        symbol->has<ObjectEntityDetails>() ||
         symbol->has<AssocEntityDetails>()) {
-      // Symbols with DerivedTypeDetails, ObjectEntityDetails and
-      // AssocEntityDetails are accepted here as procedure-designators because
-      // this means the related FunctionReference are mis-parsed structure
-      // constructors or array references that will be fixed later when
-      // analyzing expressions.
+      // Symbols with DerivedTypeDetails and AssocEntityDetails are accepted
+      // here as procedure-designators because this means the related
+      // FunctionReference are mis-parsed structure constructors or array
+      // references that will be fixed later when analyzing expressions.
+    } else if (symbol->has<ObjectEntityDetails>()) {
+      // Symbols with ObjectEntityDetails are also accepted because this can be
+      // a mis-parsed array references that will be fixed later. Ensure that if
+      // this is a symbol from a host procedure, a symbol with HostAssocDetails
+      // is created for the current scope.
+      if (IsUplevelReference(*symbol)) {
+        MakeHostAssocSymbol(name, *symbol);
+      }
     } else if (symbol->test(Symbol::Flag::Implicit)) {
       Say(name,
           "Use of '%s' as a procedure conflicts with its implicit definition"_err_en_US);
     } else {
       SayWithDecl(name, *symbol,
           "Use of '%s' as a procedure conflicts with its declaration"_err_en_US);
     }
   }
bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
   const auto &dataRef{std::get<parser::DataRef>(x.t)};
   const auto &bounds{std::get<parser::PointerAssignmentStmt::Bounds>(x.t)};
   const auto &expr{std::get<parser::Expr>(x.t)};
   ResolveDataRef(dataRef);
   Walk(bounds);
   // Resolve unrestricted specific intrinsic procedures as in "p => cos".
   if (const parser::Name * name{parser::Unwrap<parser::Name>(expr)}) {
     if (NameIsKnownOrIntrinsic(*name)) {
+      // If the name is known because it is an object entity from a host
+      // procedure, create a host associated symbol.
+      if (Symbol * symbol{name->symbol}; symbol &&
+          symbol->has<ObjectEntityDetails>() && IsUplevelReference(*symbol)) {
+        MakeHostAssocSymbol(*name, *symbol);
+      }
       return false;
     }
   }
   Walk(expr);
   return false;
 }
 void ResolveNamesVisitor::Post(const parser::Designator &x) {
   ResolveDesignator(x);

flang/test/Semantics/symbol03.f90

contains
   !DEF: /main/s/s2 (Subroutine) Subprogram
   subroutine s2
    !DEF: /main/s/s2/z (Implicit) ObjectEntity REAL(4)
    !DEF: /main/s/s2/x HostAssoc INTEGER(4)
    z = x
   end subroutine
  end subroutine
 end program
+
+!DEF: /s (Subroutine) Subprogram
+subroutine s
+ !DEF: /s/x ObjectEntity REAL(4)
+ real x(100, 100)
+ !DEF: /s/s1 (Subroutine) Subprogram
+ call s1
+contains
+ !REF: /s/s1
+  subroutine s1
+    !DEF: /s/s1/x HostAssoc REAL(4)
+    print *, x(10, 10)
+  end subroutine
+end subroutine
+
+!DEF: /sb (Subroutine) Subprogram
+subroutine sb
+ !DEF: /sb/x TARGET ObjectEntity REAL(4)
+ real, target :: x
+ !DEF: /sb/s1 (Subroutine) Subprogram
+ call s1
+contains
+ !REF: /sb/s1
+ subroutine s1
+  !DEF: /sb/s1/p POINTER ObjectEntity REAL(4)
+  real, pointer :: p
+  !REF: /sb/s1/p
+  !DEF: /sb/s1/x TARGET HostAssoc REAL(4)
+  p => x
+ end subroutine
+end subroutine