[flang] handle indirect module variable use in internal procedure

flang/lib/Lower/Bridge.cpp

@@ -383,6 +383,19 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       declareFunction(f);
   }
 
+  /// Get the scope that is defining or using \p sym. The returned scope is not
+  /// the ultimate scope, since this helper does not traverse use association.
+  /// This allows capturing module variables that are referenced in an internal
+  /// procedure but whose use statement is inside the host program.
+  const Fortran::semantics::Scope &
+  getSymbolHostScope(const Fortran::semantics::Symbol &sym) {
+    const Fortran::semantics::Symbol *hostSymbol = &sym;
+    while (const auto *details =
+               hostSymbol->detailsIf<Fortran::semantics::HostAssocDetails>())
+      hostSymbol = &details->symbol();
+    return hostSymbol->owner();
+  }
+
   /// Collects the canonical list of all host associated symbols. These bindings
   /// must be aggregated into a tuple which can then be added to each of the
   /// internal procedure declarations and passed at each call site.
@@ -399,12 +412,12 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       if (ultimate.has<Fortran::semantics::ObjectEntityDetails>() ||
           Fortran::semantics::IsProcedurePointer(ultimate) ||
           Fortran::semantics::IsDummy(sym) || namelistDetails) {
-        const Fortran::semantics::Scope &ultimateScope = ultimate.owner();
-        if (ultimateScope.kind() ==
+        const Fortran::semantics::Scope &symbolScope = getSymbolHostScope(sym);
+        if (symbolScope.kind() ==
                 Fortran::semantics::Scope::Kind::MainProgram ||
-            ultimateScope.kind() == Fortran::semantics::Scope::Kind::Subprogram)
-          if (ultimateScope != *internalScope &&
-              ultimateScope.Contains(*internalScope)) {
+            symbolScope.kind() == Fortran::semantics::Scope::Kind::Subprogram)
+          if (symbolScope != *internalScope &&
+              symbolScope.Contains(*internalScope)) {
             if (namelistDetails) {
               // So far, namelist symbols are processed on the fly in IO and
               // the related namelist data structure is not added to the symbol

flang/test/Lower/HLFIR/internal-procedures-2.f90

@@ -0,0 +1,29 @@
+! Test instantiation of module variables inside an internal subprogram
+! where the use statement is inside the host program.
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+module module_used_by_host
+ implicit none
+ integer :: indexed_by_var(2)
+ integer :: ref_in_implied_do
+ integer :: ref_in_forall(2)
+end module
+
+subroutine host_procedure
+ use module_used_by_host
+ implicit none
+contains
+ subroutine internal_procedure(i, mask)
+  integer :: i
+  logical :: mask(2)
+  indexed_by_var(i) = 0
+  print *, (/(ref_in_implied_do, integer::j=1,10)/)
+  forall (integer::k = 1:2)
+    ref_in_forall(k) = 0
+  end forall
+ end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QFhost_procedurePinternal_procedure(
+! CHECK:    fir.address_of(@_QMmodule_used_by_hostEindexed_by_var) : !fir.ref<!fir.array<2xi32>>
+! CHECK:    fir.address_of(@_QMmodule_used_by_hostEref_in_forall) : !fir.ref<!fir.array<2xi32>>
+! CHECK:    fir.address_of(@_QMmodule_used_by_hostEref_in_implied_do) : !fir.ref<i32>

flang/test/Lower/explicit-interface-results-2.f90

@@ -94,7 +94,7 @@ subroutine host5()
   implicit none
   call internal_proc_a()
 contains
-! CHECK-LABEL: func @_QFhost5Pinternal_proc_a() {
+! CHECK-LABEL: func @_QFhost5Pinternal_proc_a() attributes {fir.internal_proc} {
   subroutine internal_proc_a()
     call takes_array(return_array())
 ! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QMsome_moduleEn_module) : !fir.ref<i32>