[flang] Do not convey captured globals through host link

[jeanPerier]

Summary

Addresses and properties (bounds, length parameters) of host
variables associated in an internal procedure were all passed via
an extra tuple argument of the internal procedure.
This extra tuple is in general an overhead: it must be created and
passed, and require creating thunks when taking the address of the
internal procedure.
This patch allows not using the tuple for host global variables
(from modules, common block, or local saved variables) since they can
be instantiated from the fir.global symbol in the internal procedure
instead.

[PeteSteinfeld]

Aside from the name of hasTupleAssociations(), all builds and tests correctly and looks good.

flang/include/flang/Lower/HostAssociations.h

35–37

This doesn't seem right. hasTupleAssociations() returns true when there are no tuple symbols? Should this be called hasNoTupleAssociations()?

[jeanPerier]

flang/include/flang/Lower/HostAssociations.h

35–37

Woops, of course, thanks ! I will actually keep the name and reverse the logic since its only use is negating it (so that I can remove the negation).

[jeanPerier]

Honor hasTupleAssociations name by reversing the logic inside and at its use point.

Update one piece of code in ArrayCopyValue that relied on the presence of a tuple
argument to detect internal procedures. Add an fir.internal_proc attribute to internal
function that are capturing host variables so that they can be easily detected even if
they do not have a tuple argument (I thought about using the mangling, but thought
an attribute would be stronger).

flang/include/flang/Lower/CallInterface.h

public:
   mlir::Type getResultStorageType() const;
 
   // Copy of base implementation.
   static constexpr bool hasHostAssociated() { return false; }
   mlir::Type getHostAssociatedTy() const {
     llvm_unreachable("getting host associated type in CallerInterface");
   }
 
+  /// Set attributes on MLIR function.
+  void setFuncAttrs(mlir::func::FuncOp) const {}
+
 private:
   /// Check that the input vector is complete.
   bool verifyActualInputs() const;
   const Fortran::evaluate::ProcedureRef &procRef;
   llvm::SmallVector<mlir::Value> actualInputs;
 };
 
 //===----------------------------------------------------------------------===//
public:
 
   /// Add mlir::func::FuncOp entry block and map fir block arguments to Fortran
   /// dummy argument symbols.
   mlir::func::FuncOp addEntryBlockAndMapArguments();
 
   bool hasHostAssociated() const;
   mlir::Type getHostAssociatedTy() const;
   mlir::Value getHostAssociatedTuple() const;
+  void setFuncAttrs(mlir::func::FuncOp) const;
 
 private:
   Fortran::lower::pft::FunctionLikeUnit &funit;
 };
 
 /// Translate a procedure characteristics to an mlir::FunctionType signature.
 mlir::FunctionType
 translateSignature(const Fortran::evaluate::ProcedureDesignator &,

flang/include/flang/Lower/HostAssociations.h

 #include "mlir/IR/Location.h"
 #include "mlir/IR/Types.h"
 #include "mlir/IR/Value.h"
 #include "llvm/ADT/SetVector.h"
 
 namespace Fortran {
 namespace semantics {
 class Symbol;
-}
+class Scope;
+} // namespace semantics
 
 namespace lower {
 class AbstractConverter;
 class SymMap;
 
 /// Internal procedures in Fortran may access variables declared in the host
 /// procedure directly. We bundle these variables together in a tuple and pass
 /// them as an extra argument.
 class HostAssociations {
 public:
   /// Returns true iff there are no host associations.
-  bool empty() const { return symbols.empty(); }
+  bool empty() const { return tupleSymbols.empty() && globalSymbols.empty(); }
+
+  /// Returns true iff there are host associations that are conveyed through
+  /// an extra tuple argument.
+  bool hasTupleAssociations() const { return !tupleSymbols.empty(); }
 
   /// Adds a set of Symbols that will be the host associated bindings for this
   /// host procedure.
   void addSymbolsToBind(
-      const llvm::SetVector<const Fortran::semantics::Symbol *> &s) {
-    assert(empty() && "symbol set must be initially empty");
-    symbols = s;
-  }
+      const llvm::SetVector<const Fortran::semantics::Symbol *> &symbols,
+      const Fortran::semantics::Scope &hostScope);
 
   /// Code gen the FIR for the local bindings for the host associated symbols
   /// for the host (parent) procedure using `builder`.
   void hostProcedureBindings(AbstractConverter &converter, SymMap &symMap);
 
   /// Code gen the FIR for the local bindings for the host associated symbols
   /// for an internal (child) procedure using `builder`.
   void internalProcedureBindings(AbstractConverter &converter, SymMap &symMap);
 
   /// Return the type of the extra argument to add to each internal procedure.
   mlir::Type getArgumentType(AbstractConverter &convert);
 
   /// Is \p symbol host associated ?
   bool isAssociated(const Fortran::semantics::Symbol &symbol) const {
-    return symbols.contains(&symbol);
+    return tupleSymbols.contains(&symbol) || globalSymbols.contains(&symbol);
   }
 
 private:
-  /// Canonical vector of host associated symbols.
-  llvm::SetVector<const Fortran::semantics::Symbol *> symbols;
+  /// Canonical vector of host associated local symbols.
+  llvm::SetVector<const Fortran::semantics::Symbol *> tupleSymbols;
+
+  /// Canonical vector of host associated global symbols.
+  llvm::SetVector<const Fortran::semantics::Symbol *> globalSymbols;
 
   /// The type of the extra argument to be added to each internal procedure.
   mlir::Type argType;
+
+  /// Scope of the parent procedure if addSymbolsToBind was called.
+  const Fortran::semantics::Scope *hostScope;
 };
 } // namespace lower
 } // namespace Fortran
 
 #endif // FORTRAN_LOWER_HOSTASSOCIATIONS_H

flang/include/flang/Lower/PFTBuilder.h

struct FunctionLikeUnit : public ProgramUnit {
   }
 
   //===--------------------------------------------------------------------===//
   // Host associations
   //===--------------------------------------------------------------------===//
 
   void setHostAssociatedSymbols(
       const llvm::SetVector<const semantics::Symbol *> &symbols) {
-    hostAssociations.addSymbolsToBind(symbols);
+    hostAssociations.addSymbolsToBind(symbols, getScope());
   }
 
   /// Return the host associations, if any, from the parent (host) procedure.
   /// Crashes if the parent is not a procedure.
   HostAssociations &parentHostAssoc();
 
   /// Return true iff the parent is a procedure and the parent has a non-empty
-  /// set of host associations.
+  /// set of host associations that are conveyed through an extra tuple
+  /// argument.
+  bool parentHasTupleHostAssoc();
+
+  /// Return true iff the parent is a procedure and the parent has a non-empty
+  /// set of host associations for variables.
   bool parentHasHostAssoc();
 
   /// Return the host associations for this function like unit. The list of host
   /// associations are kept in the host procedure.
   HostAssociations &getHostAssoc() { return hostAssociations; }
 
   LLVM_DUMP_METHOD void dump() const;
 

flang/include/flang/Optimizer/Dialect/FIROpsSupport.h

static constexpr llvm::StringRef getSymbolAttrName() {
   return "fir.bindc_name";
 }
 
 /// Attribute to mark a function that takes a host associations argument.
 static constexpr llvm::StringRef getHostAssocAttrName() {
   return "fir.host_assoc";
 }
 
+/// Attribute to mark an internal procedure.
+static constexpr llvm::StringRef getInternalProcedureAttrName() {
+  return "fir.internal_proc";
+}
+
 /// Does the function, \p func, have a host-associations tuple argument?
 /// Some internal procedures may have access to host procedure variables.
 bool hasHostAssociationArgument(mlir::func::FuncOp func);
 
+/// Is the function, \p func an internal procedure ?
+/// Some internal procedures may have access to saved host procedure
+/// variables even when they do not have a tuple argument.
+inline bool isInternalPorcedure(mlir::func::FuncOp func) {
+  return func->hasAttr(fir::getInternalProcedureAttrName());
+}
+
 /// Tell if \p value is:
 ///   - a function argument that has attribute \p attributeName
 ///   - or, the result of fir.alloca/fir.allocamem op that has attribute \p
 ///     attributeName
 ///   - or, the result of a fir.address_of of a fir.global that has attribute \p
 ///     attributeName
 ///   - or, a fir.box loaded from a fir.ref<fir.box> that matches one of the
 ///     previous cases.

flang/lib/Lower/Bridge.cpp

auto mapPassedEntity = [&](const auto arg) {
             }
             if (fir::isa_trivial(argTy)) {
               mapTrivialByValue(arg.entity->get(), arg.firArgument);
               return;
             }
           }
           addSymbol(arg.entity->get(), arg.firArgument);
         } else {
-          assert(funit.parentHasHostAssoc());
-          funit.parentHostAssoc().internalProcedureBindings(*this,
-                                                            localSymbols);
+          assert(funit.parentHasTupleHostAssoc() && "expect tuple argument");
         }
       }
     };
     for (const Fortran::lower::CalleeInterface::PassedEntity &arg :
          callee.getPassedArguments())
       mapPassedEntity(arg);
     if (std::optional<Fortran::lower::CalleeInterface::PassedEntity>
             passedResult = callee.getPassedResult()) {
void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
     builder = new fir::FirOpBuilder(func, bridge.getKindMap());
     assert(builder && "FirOpBuilder did not instantiate");
     builder->setFastMathFlags(bridge.getLoweringOptions().getMathOptions());
     builder->setInsertionPointToStart(&func.front());
     func.setVisibility(mlir::SymbolTable::Visibility::Public);
 
     mapDummiesAndResults(funit, callee);
 
+    // Map host associated symbols from parent procedure if any.
+    if (funit.parentHasHostAssoc())
+      funit.parentHostAssoc().internalProcedureBindings(*this, localSymbols);
+
     // Non-primary results of a function with multiple entry points.
     // These result values share storage with the primary result.
     llvm::SmallVector<Fortran::lower::pft::Variable> deferredFuncResultList;
 
     // Backup actual argument for entry character results with different
     // lengths. It needs to be added to the non-primary results symbol before
     // mapSymbolAttributes is called.
     Fortran::lower::SymbolBox resultArg;
for (const Fortran::lower::pft::Variable &var :
       }
       const Fortran::semantics::Symbol &sym = var.getSymbol();
       if (funit.parentHasHostAssoc()) {
         // Never instantiate host associated variables, as they are already
         // instantiated from an argument tuple. Instead, just bind the symbol
         // to the host variable, which must be in the map.
         const Fortran::semantics::Symbol &ultimate = sym.GetUltimate();
         if (funit.parentHostAssoc().isAssociated(ultimate)) {
-          Fortran::lower::SymbolBox hostBox = lookupSymbol(ultimate);
-          assert(hostBox && "host association is not in map");
-          localSymbols.addSymbol(sym, hostBox.toExtendedValue());
+          copySymbolBinding(ultimate, sym);
           continue;
         }
       }
       if (!sym.IsFuncResult() || !funit.primaryResult) {
         instantiateVar(var, storeMap);
       } else if (&sym == funit.primaryResult) {
         instantiateVar(var, storeMap);
         primaryFuncResultStorage = getSymbolAddress(sym);

flang/lib/Lower/CallInterface.cpp

Fortran::lower::CalleeInterface::addEntryBlockAndMapArguments() {
   // On the callee side, directly map the mlir::value argument of the function
   // block to the Fortran symbols.
   func.addEntryBlock();
   mapPassedEntities();
   return func;
 }
 
 bool Fortran::lower::CalleeInterface::hasHostAssociated() const {
-  return funit.parentHasHostAssoc();
+  return funit.parentHasTupleHostAssoc();
 }
 
 mlir::Type Fortran::lower::CalleeInterface::getHostAssociatedTy() const {
   assert(hasHostAssociated());
   return funit.parentHostAssoc().getArgumentType(converter);
 }
 
 mlir::Value Fortran::lower::CalleeInterface::getHostAssociatedTuple() const {
   assert(hasHostAssociated() || !funit.getHostAssoc().empty());
   return converter.hostAssocTupleValue();
 }
 
+void Fortran::lower::CalleeInterface::setFuncAttrs(
+    mlir::func::FuncOp func) const {
+  if (funit.parentHasHostAssoc())
+    func->setAttr(fir::getInternalProcedureAttrName(),
+                  mlir::UnitAttr::get(func->getContext()));
+}
+
 //===----------------------------------------------------------------------===//
 // CallInterface implementation: this part is common to both caller and caller
 // sides.
 //===----------------------------------------------------------------------===//
 
 static void addSymbolAttribute(mlir::func::FuncOp func,
                                const Fortran::semantics::Symbol &sym,
                                mlir::MLIRContext &mlirContext) {
if (!func) {
       mlir::Location loc = side().getCalleeLocation();
       mlir::FunctionType ty = genFunctionType();
       func = fir::FirOpBuilder::createFunction(loc, module, name, ty);
       if (const Fortran::semantics::Symbol *sym = side().getProcedureSymbol())
         addSymbolAttribute(func, *sym, converter.getMLIRContext());
       for (const auto &placeHolder : llvm::enumerate(inputs))
         if (!placeHolder.value().attributes.empty())
           func.setArgAttrs(placeHolder.index(), placeHolder.value().attributes);
+      side().setFuncAttrs(func);
     }
   }
 }
 
 /// Once the signature has been analyzed and the mlir::func::FuncOp was
 /// built/found, map the fir inputs to Fortran entities (the symbols or
 /// expressions).
 template <typename T>

flang/lib/Lower/HostAssociations.cpp

 //===-- HostAssociations.cpp ----------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/HostAssociations.h"
 #include "flang/Evaluate/check-expression.h"
 #include "flang/Lower/AbstractConverter.h"
 #include "flang/Lower/Allocatable.h"
 #include "flang/Lower/BoxAnalyzer.h"
 #include "flang/Lower/CallInterface.h"
 #include "flang/Lower/ConvertType.h"
+#include "flang/Lower/ConvertVariable.h"
 #include "flang/Lower/PFTBuilder.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Support/FatalError.h"
 #include "flang/Semantics/tools.h"
 #include "llvm/ADT/TypeSwitch.h"
static mlir::Value genTupleCoor(fir::FirOpBuilder &builder, mlir::Location loc,
   // fir.ref<fir.ref> and fir.ptr<fir.ref> are forbidden. Use
   // fir.llvm_ptr if needed.
   auto ty = varTy.isa<fir::ReferenceType>()
                 ? mlir::Type(fir::LLVMPointerType::get(varTy))
                 : mlir::Type(builder.getRefType(varTy));
   return builder.create<fir::CoordinateOp>(loc, ty, tupleArg, offset);
 }
 
+void Fortran::lower::HostAssociations::addSymbolsToBind(
+    const llvm::SetVector<const Fortran::semantics::Symbol *> &symbols,
+    const Fortran::semantics::Scope &hostScope) {
+  assert(tupleSymbols.empty() && globalSymbols.empty() &&
+         "must be initially empty");
+  this->hostScope = &hostScope;
+  for (const auto *s : symbols)
+    if (Fortran::lower::symbolIsGlobal(*s))
+      // The ultimate symbol is stored here so that global symbols from the
+      // host scope can later be searched in this set.
+      globalSymbols.insert(&s->GetUltimate());
+    else
+      tupleSymbols.insert(s);
+}
+
 void Fortran::lower::HostAssociations::hostProcedureBindings(
     Fortran::lower::AbstractConverter &converter,
     Fortran::lower::SymMap &symMap) {
-  if (symbols.empty())
+  if (tupleSymbols.empty())
     return;
 
   // Create the tuple variable.
   mlir::TupleType tupTy = unwrapTupleTy(getArgumentType(converter));
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   mlir::Location loc = converter.getCurrentLocation();
   auto hostTuple = builder.create<fir::AllocaOp>(loc, tupTy);
   mlir::IntegerType offTy = builder.getIntegerType(32);
 
-  // Walk the list of symbols and update the pointers in the tuple.
-  for (auto s : llvm::enumerate(symbols)) {
+  // Walk the list of tupleSymbols and update the pointers in the tuple.
+  for (auto s : llvm::enumerate(tupleSymbols)) {
     auto indexInTuple = s.index();
     mlir::Value off = builder.createIntegerConstant(loc, offTy, indexInTuple);
     mlir::Type varTy = tupTy.getType(indexInTuple);
     mlir::Value eleOff = genTupleCoor(builder, loc, varTy, hostTuple, off);
     InstantiateHostTuple instantiateHostTuple{
         symMap.lookupSymbol(s.value()).toExtendedValue(), eleOff, loc};
     walkCaptureCategories(instantiateHostTuple, converter, *s.value());
   }
 
   converter.bindHostAssocTuple(hostTuple);
 }
 
 void Fortran::lower::HostAssociations::internalProcedureBindings(
     Fortran::lower::AbstractConverter &converter,
     Fortran::lower::SymMap &symMap) {
-  if (symbols.empty())
+  if (!globalSymbols.empty()) {
+    assert(hostScope && "host scope must have been set");
+    Fortran::lower::AggregateStoreMap storeMap;
+    // The host scope variable list is required to deal with host variables
+    // that are equivalenced and requires instantiating the right global
+    // AggregateStore.
+    for (auto &hostVariable : pft::getScopeVariableList(*hostScope))
+      if ((hostVariable.isAggregateStore() && hostVariable.isGlobal()) ||
+          (hostVariable.hasSymbol() &&
+           globalSymbols.contains(&hostVariable.getSymbol().GetUltimate())))
+        Fortran::lower::instantiateVariable(converter, hostVariable, symMap,
+                                            storeMap);
+  }
+  if (tupleSymbols.empty())
     return;
 
   // Find the argument with the tuple type. The argument ought to be appended.
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   mlir::Type argTy = getArgumentType(converter);
   mlir::TupleType tupTy = unwrapTupleTy(argTy);
   mlir::Location loc = converter.getCurrentLocation();
   mlir::func::FuncOp func = builder.getFunction();
   mlir::Value tupleArg;
   for (auto [ty, arg] : llvm::reverse(llvm::zip(
            func.getFunctionType().getInputs(), func.front().getArguments())))
     if (ty == argTy) {
       tupleArg = arg;
       break;
     }
   if (!tupleArg)
     fir::emitFatalError(loc, "no host association argument found");
 
   converter.bindHostAssocTuple(tupleArg);
 
   mlir::IntegerType offTy = builder.getIntegerType(32);
 
   // Walk the list and add the bindings to the symbol table.
-  for (auto s : llvm::enumerate(symbols)) {
+  for (auto s : llvm::enumerate(tupleSymbols)) {
     mlir::Value off = builder.createIntegerConstant(loc, offTy, s.index());
     mlir::Type varTy = tupTy.getType(s.index());
     mlir::Value eleOff = genTupleCoor(builder, loc, varTy, tupleArg, off);
     mlir::Value valueInTuple = builder.create<fir::LoadOp>(loc, eleOff);
     GetFromTuple getFromTuple{symMap, valueInTuple, loc};
     walkCaptureCategories(getFromTuple, converter, *s.value());
   }
 }
 
 mlir::Type Fortran::lower::HostAssociations::getArgumentType(
     Fortran::lower::AbstractConverter &converter) {
-  if (symbols.empty())
+  if (tupleSymbols.empty())
     return {};
   if (argType)
     return argType;
 
   // Walk the list of Symbols and create their types. Wrap them in a reference
   // to a tuple.
   mlir::MLIRContext *ctxt = &converter.getMLIRContext();
   llvm::SmallVector<mlir::Type> tupleTys;
-  for (const Fortran::semantics::Symbol *sym : symbols)
+  for (const Fortran::semantics::Symbol *sym : tupleSymbols)
     tupleTys.emplace_back(
         walkCaptureCategories(GetTypeInTuple{}, converter, *sym));
   argType = fir::ReferenceType::get(mlir::TupleType::get(ctxt, tupleTys));
   return argType;
 }

flang/lib/Lower/PFTBuilder.cpp

 
 Fortran::lower::HostAssociations &
 Fortran::lower::pft::FunctionLikeUnit::parentHostAssoc() {
   if (auto *par = parent.getIf<FunctionLikeUnit>())
     return par->hostAssociations;
   llvm::report_fatal_error("parent is not a function");
 }
 
+bool Fortran::lower::pft::FunctionLikeUnit::parentHasTupleHostAssoc() {
+  if (auto *par = parent.getIf<FunctionLikeUnit>())
+    return par->hostAssociations.hasTupleAssociations();
+  return false;
+}
+
 bool Fortran::lower::pft::FunctionLikeUnit::parentHasHostAssoc() {
   if (auto *par = parent.getIf<FunctionLikeUnit>())
     return !par->hostAssociations.empty();
   return false;
 }
 
 parser::CharBlock
 Fortran::lower::pft::FunctionLikeUnit::getStartingSourceLoc() const {

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

 // modifying the output array.
 static bool
 conservativeCallConflict(llvm::ArrayRef<mlir::Operation *> reaches) {
   return llvm::any_of(reaches, [](mlir::Operation *op) {
     if (auto call = mlir::dyn_cast<fir::CallOp>(op))
       if (auto callee =
               call.getCallableForCallee().dyn_cast<mlir::SymbolRefAttr>()) {
         auto module = op->getParentOfType<mlir::ModuleOp>();
-        return hasHostAssociationArgument(
+        return isInternalPorcedure(
             module.lookupSymbol<mlir::func::FuncOp>(callee));
       }
     return false;
   });
 }
 
 /// Constructor of the array copy analysis.
 /// This performs the analysis and saves the intermediate results.

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

 ! Test internal procedure A calling array internal procedure B.
 ! Result depends on host variable not directly used in A.
 subroutine host4()
   implicit none
   integer :: n
   call internal_proc_a()
 contains
 ! CHECK-LABEL: func @_QFhost4Pinternal_proc_a
-! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) {
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.internal_proc} {
   subroutine internal_proc_a()
     call takes_array(return_array())
 ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
 ! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
 ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.llvm_ptr<!fir.ref<i32>>
 ! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
 ! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index
 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_5]], %{{.*}} : index
function return_array()
     integer :: n_common
     common /mycom/ n_common
     real :: return_array(n_common)
   end function
 end subroutine
 
 ! Test internal procedure A calling array internal procedure B.
 ! Result depends on a common block variable declared in the host.
-! Note that the current implementation captures the common block variable
-! address, even though it could recompute it in the internal procedure.
 subroutine host9()
   implicit none
   integer :: n_common
   common /mycom/ n_common
   call internal_proc_a()
 contains
 ! CHECK-LABEL: func @_QFhost9Pinternal_proc_a
-! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) {
   subroutine internal_proc_a()
-! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
-! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
-! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.llvm_ptr<!fir.ref<i32>>
-! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
-! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index
-! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_5]], %{{.*}} : index
-! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_5]], %{{.*}} : index
-! CHECK:  %[[VAL_6:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}
+! CHECK:  %[[VAL_0:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_1:.*]] = fir.address_of(@_QBmycom) : !fir.ref<!fir.array<4xi8>>
+! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
+! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>
+! CHECK:  %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
+! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
+! CHECK:  %[[VAL_7:.*]] = arith.cmpi sgt, %[[VAL_6]], %[[VAL_0]] : index
+! CHECK:  %[[VAL_8:.*]] = arith.select %[[VAL_7]], %[[VAL_6]], %[[VAL_0]] : index
+! CHECK:  %[[VAL_10:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_8]] {bindc_name = ".result"}
     call takes_array(return_array())
   end subroutine
   function return_array()
     use :: some_module
     real :: return_array(n_common)
   end function
 end subroutine
 

flang/test/Lower/host-associated-functions.f90

subroutine capture_char_func_dummy(char_func_dummy, n)
   ! CHECK:  fir.store %[[VAL_0]] to %[[VAL_4]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
   ! CHECK:  %[[VAL_5:.*]] = arith.constant 1 : i32
   ! CHECK:  %[[VAL_6:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_5]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
   ! CHECK:  fir.store %[[VAL_1]] to %[[VAL_6]] : !fir.llvm_ptr<!fir.ref<i32>>
   ! CHECK:  fir.call @_QFcapture_char_func_dummyPinternal(%[[VAL_2]]) {{.*}}: (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>) -> ()
   call internal()
 contains
   ! CHECK-LABEL: func @_QFcapture_char_func_dummyPinternal(
-  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>> {fir.host_assoc}) {
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>> {fir.host_assoc}) attributes {fir.internal_proc} {
   subroutine internal()
   ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
   ! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
   ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
   ! CHECK:  %[[VAL_4:.*]] = arith.constant 1 : i32
   ! CHECK:  %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_4]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
   ! CHECK:  %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.llvm_ptr<!fir.ref<i32>>
   ! CHECK:  %[[VAL_12:.*]] = fir.extract_value %[[VAL_3]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>

 ! CHECK:  %[[VAL_1:.*]] = fir.alloca tuple<tuple<!fir.boxproc<() -> ()>, i64>>
 ! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : i32
 ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
 ! CHECK:  fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
 ! CHECK:  fir.call @_QFcapture_char_func_assumed_dummyPinternal(%[[VAL_1]]) {{.*}}: (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>) -> ()
   call internal()
 contains
 ! CHECK-LABEL: func @_QFcapture_char_func_assumed_dummyPinternal(
-! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>> {fir.host_assoc}) {
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>> {fir.host_assoc}) attributes {fir.internal_proc} {
   subroutine internal()
 ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
 ! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
 ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
 ! CHECK:  %[[VAL_9:.*]] = fir.extract_value %[[VAL_3]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
 ! CHECK:  %[[VAL_10:.*]] = fir.box_addr %[[VAL_9]] : (!fir.boxproc<() -> ()>) -> (() -> ())
 ! CHECK:  %[[VAL_11:.*]] = fir.extract_value %[[VAL_3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
 ! CHECK:  %[[VAL_12:.*]] = fir.call @llvm.stacksave() {{.*}}: () -> !fir.ref<i8>

 ! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : i32
 ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
 ! CHECK:  fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.llvm_ptr<!fir.ref<i32>>
 ! CHECK:  fir.call @_QFcapture_array_funcPinternal(%[[VAL_1]]) {{.*}}: (!fir.ref<tuple<!fir.ref<i32>>>) -> ()
   call internal()
 contains
   subroutine internal()
 ! CHECK-LABEL: func @_QFcapture_array_funcPinternal(
-! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) {
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.internal_proc} {
 ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
 ! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
 ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.llvm_ptr<!fir.ref<i32>>
 ! CHECK:  %[[VAL_9:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
 ! CHECK:  %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> i64
 ! CHECK:  %[[VAL_11:.*]] = arith.constant 1 : i64
 ! CHECK:  %[[VAL_12:.*]] = arith.subi %[[VAL_10]], %[[VAL_11]] : i64
 ! CHECK:  %[[VAL_13:.*]] = arith.constant 1 : i64

flang/test/Lower/host-associated-globals.f90

+! Test lowering of internal procedure host association for global variables
+! A tuple function argument should not be created for associated globals, and
+! instead globals should be instantiated with a fir.address_of inside the
+! contained procedures.
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+module test_mod_used_in_host
+  integer :: i, j_in_equiv
+  integer :: not_in_equiv
+  equivalence (i,j_in_equiv)
+end module
+
+subroutine module_var()
+  use test_mod_used_in_host
+  call bar()
+contains
+ subroutine bar()
+    print *, j_in_equiv, not_in_equiv
+ end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QFmodule_varPbar()
+! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QMtest_mod_used_in_hostEi) : !fir.ref<!fir.array<4xi8>>
+! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
+! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! CHECK:  %[[VAL_4:.*]] = fir.address_of(@_QMtest_mod_used_in_hostEnot_in_equiv) : !fir.ref<i32>
+
+subroutine test_common()
+  integer, save :: i(2)
+  integer, save :: j_in_equiv
+  integer, save :: not_in_equiv
+  equivalence (i(2),j_in_equiv)
+  common /x/ i, not_in_equiv
+  call bar()
+contains
+ subroutine bar()
+    print *, j_in_equiv, not_in_equiv
+ end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QFtest_commonPbar() attributes {fir.internal_proc} {
+! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QBx) : !fir.ref<!fir.array<12xi8>>
+! CHECK:  %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<12xi8>>) -> !fir.ref<!fir.array<?xi8>>
+! CHECK:  %[[VAL_2:.*]] = arith.constant 4 : index
+! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<12xi8>>) -> !fir.ref<!fir.array<?xi8>>
+! CHECK:  %[[VAL_6:.*]] = arith.constant 8 : index
+! CHECK:  %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_6]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref<i8>) -> !fir.ref<i32>
+
+subroutine saved_equiv()
+  integer, save :: i(2)
+  integer, save :: j_in_equiv
+  integer, save :: not_in_equiv
+  equivalence (i(2),j_in_equiv)
+  call bar()
+contains
+ subroutine bar()
+    print *, j_in_equiv, not_in_equiv
+ end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QFsaved_equivPbar() attributes {fir.internal_proc} {
+! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QFsaved_equivEi) : !fir.ref<!fir.array<8xi8>>
+! CHECK:  %[[VAL_1:.*]] = arith.constant 4 : index
+! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<!fir.array<8xi8>>, index) -> !fir.ref<i8>
+! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! CHECK:  %[[VAL_4:.*]] = fir.address_of(@_QFsaved_equivEnot_in_equiv) : !fir.ref<i32>
+
+subroutine mixed_capture()
+  integer, save :: saved_i
+  integer, save :: saved_j
+  equivalence (saved_i, saved_j)
+  integer :: i
+  integer :: j
+  equivalence (i,j)
+  call bar()
+contains
+ subroutine bar()
+    call test(saved_j, j)
+ end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QFmixed_capturePbar(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.internal_proc} {
+! CHECK:  %[[VAL_1:.*]] = fir.address_of(@_QFmixed_captureEsaved_i) : !fir.ref<!fir.array<4xi8>>
+! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
+! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! CHECK:  %[[VAL_5:.*]] = arith.constant 0 : i32
+! CHECK:  %[[VAL_6:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_5]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
+! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_6]] : !fir.llvm_ptr<!fir.ref<i32>>
+! CHECK:  %[[VAL_9:.*]] = fir.convert %[[VAL_4]] : (!fir.ptr<i32>) -> !fir.ref<i32>
+! CHECK:  fir.call @_QPtest(%[[VAL_9]], %[[VAL_7]]) {{.*}} : (!fir.ref<i32>, !fir.ref<i32>) -> ()

flang/test/Lower/host-associated.f90

subroutine test1
   ! CHECK-DAG: %[[tup:.*]] = fir.alloca tuple<!fir.ref<i32>>
   ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[tup]], %c0
   ! CHECK: fir.store %[[i]] to %[[addr]] : !fir.llvm_ptr<!fir.ref<i32>>
   ! CHECK: fir.call @_QFtest1Ptest1_internal(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.ref<i32>>>) -> ()
   call test1_internal
   print *, i
 contains
   ! CHECK-LABEL: func @_QFtest1Ptest1_internal(
-  ! CHECK-SAME: %[[arg:[^:]*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) {
+  ! CHECK-SAME: %[[arg:[^:]*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.internal_proc} {
   ! CHECK: %[[iaddr:.*]] = fir.coordinate_of %[[arg]], %c0
   ! CHECK: %[[i:.*]] = fir.load %[[iaddr]] : !fir.llvm_ptr<!fir.ref<i32>>
   ! CHECK: %[[val:.*]] = fir.call @_QPifoo() {{.*}}: () -> i32
   ! CHECK: fir.store %[[val]] to %[[i]] : !fir.ref<i32>
   subroutine test1_internal
     integer, external :: ifoo
     i = ifoo()
   end subroutine test1_internal
subroutine test2
   ! CHECK: fir.store %{{.*}} to %[[a0]] : !fir.llvm_ptr<!fir.ref<f32>>
   ! CHECK: %[[b0:.*]] = fir.coordinate_of %[[tup]], %c1
   ! CHECK: fir.store %{{.*}} to %[[b0]] : !fir.llvm_ptr<!fir.ref<f32>>
   ! CHECK: fir.call @_QFtest2Ptest2_internal(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.ref<f32>, !fir.ref<f32>>>) -> ()
   call test2_internal
   print *, a, b
 contains
   ! CHECK-LABEL: func @_QFtest2Ptest2_internal(
-  ! CHECK-SAME: %[[arg:[^:]*]]: !fir.ref<tuple<!fir.ref<f32>, !fir.ref<f32>>> {fir.host_assoc}) {
+  ! CHECK-SAME: %[[arg:[^:]*]]: !fir.ref<tuple<!fir.ref<f32>, !fir.ref<f32>>> {fir.host_assoc}) attributes {fir.internal_proc} {
   subroutine test2_internal
     ! CHECK: %[[a:.*]] = fir.coordinate_of %[[arg]], %c0
     ! CHECK: %[[aa:.*]] = fir.load %[[a]] : !fir.llvm_ptr<!fir.ref<f32>>
     ! CHECK: %[[b:.*]] = fir.coordinate_of %[[arg]], %c1
     ! CHECK: %{{.*}} = fir.load %[[b]] : !fir.llvm_ptr<!fir.ref<f32>>
     ! CHECK: fir.alloca
     ! CHECK: fir.load %[[aa]] : !fir.ref<f32>
     c = a
     a = b
     b = c
     call test2_inner
   end subroutine test2_internal
 
   ! CHECK-LABEL: func @_QFtest2Ptest2_inner(
-  ! CHECK-SAME: %[[arg:[^:]*]]: !fir.ref<tuple<!fir.ref<f32>, !fir.ref<f32>>> {fir.host_assoc}) {
+  ! CHECK-SAME: %[[arg:[^:]*]]: !fir.ref<tuple<!fir.ref<f32>, !fir.ref<f32>>> {fir.host_assoc}) attributes {fir.internal_proc} {
   subroutine test2_inner
     ! CHECK: %[[a:.*]] = fir.coordinate_of %[[arg]], %c0
     ! CHECK: %[[aa:.*]] = fir.load %[[a]] : !fir.llvm_ptr<!fir.ref<f32>>
     ! CHECK: %[[b:.*]] = fir.coordinate_of %[[arg]], %c1
     ! CHECK: %[[bb:.*]] = fir.load %[[b]] : !fir.llvm_ptr<!fir.ref<f32>>
     ! CHECK-DAG: %[[bd:.*]] = fir.load %[[bb]] : !fir.ref<f32>
     ! CHECK-DAG: %[[ad:.*]] = fir.load %[[aa]] : !fir.ref<f32>
     ! CHECK: %{{.*}} = arith.cmpf ogt, %[[ad]], %[[bd]] : f32
subroutine test6(c)
   ! CHECK: %[[emboxchar:.*]] = fir.emboxchar %[[cunbox]]#0, %[[cunbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
   ! CHECK: fir.store %[[emboxchar]] to %[[coor]] : !fir.ref<!fir.boxchar<1>>
   ! CHECK: fir.call @_QFtest6Ptest6_inner(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.boxchar<1>>>) -> ()
   call test6_inner
   print *, c
 
 contains
   ! CHECK-LABEL: func @_QFtest6Ptest6_inner(
-  ! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.boxchar<1>>> {fir.host_assoc}) {
+  ! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.boxchar<1>>> {fir.host_assoc}) attributes {fir.internal_proc} {
   subroutine test6_inner
     ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
     ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.boxchar<1>>
     ! CHECK: fir.unboxchar %[[load]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
     c = "Hi there"
   end subroutine test6_inner
 end subroutine test6
 
subroutine test3(p,q,i)
   call test3_inner
 
   if (p(2) .ne. -42.0) then
      print *, "failed"
   end if
   
 contains
   ! CHECK-LABEL: func @_QFtest3Ptest3_inner(
-  ! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>> {fir.host_assoc}) {
+  ! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>> {fir.host_assoc}) attributes {fir.internal_proc} {
   subroutine test3_inner
     ! CHECK: %[[pcoor:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>
     ! CHECK: %[[p:.*]] = fir.load %[[pcoor]] : !fir.ref<!fir.box<!fir.array<?xf32>>>
     ! CHECK: %[[pbounds:.]]:3 = fir.box_dims %[[p]], %c0{{.*}} : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
     ! CHECK: %[[qcoor:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>
     ! CHECK: %[[q:.*]] = fir.load %[[qcoor]] : !fir.ref<!fir.box<!fir.array<?xf32>>>
     ! CHECK: %[[qbounds:.]]:3 = fir.box_dims %[[q]], %c0{{.*}} : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
 
subroutine test3a(p)
   call test3a_inner
 
   if (p(1) .ne. -42.0) then
      print *, "failed"
   end if
   
 contains
   ! CHECK: func @_QFtest3aPtest3a_inner(
-  ! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>> {fir.host_assoc}) {
+  ! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>> {fir.host_assoc}) attributes {fir.internal_proc} {
   subroutine test3a_inner
     ! CHECK: %[[pcoor:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<10xf32>>>
     ! CHECK: %[[p:.*]] = fir.load %[[pcoor]] : !fir.ref<!fir.box<!fir.array<10xf32>>>
     ! CHECK: %[[paddr:.*]] = fir.box_addr %[[p]] : (!fir.box<!fir.array<10xf32>>) -> !fir.ref<!fir.array<10xf32>>
     ! CHECK: %[[qcoor:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<10xf32>>>
     ! CHECK: %[[q:.*]] = fir.load %[[qcoor]] : !fir.ref<!fir.box<!fir.array<10xf32>>>
     ! CHECK: %[[qaddr:.*]] = fir.box_addr %[[q]] : (!fir.box<!fir.array<10xf32>>) -> !fir.ref<!fir.array<10xf32>>
 
subroutine test4
   call test4_inner
 
   if (p .ne. -42.0) then
      print *, "failed"
   end if
   
 contains
   ! CHECK-LABEL: func @_QFtest4Ptest4_inner(
-  ! CHECK-SAME:%[[tup:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>> {fir.host_assoc}) {
+  ! CHECK-SAME:%[[tup:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>> {fir.host_assoc}) attributes {fir.internal_proc} {
   subroutine test4_inner
     ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<f32>>>>
     ! CHECK: %[[p:.*]] = fir.load %[[ptup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<f32>>>>
     ! CHECK: %[[atup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<f32>>>>
     ! CHECK: %[[a:.*]] = fir.load %[[atup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<f32>>>>
     ! CHECK: %[[abox:.*]] = fir.load %[[a]] : !fir.ref<!fir.box<!fir.heap<f32>>>
     ! CHECK: %[[addr:.*]] = fir.box_addr %[[abox]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
     ! CHECK: %[[ptr:.*]] = fir.embox %[[addr]] : (!fir.heap<f32>) -> !fir.box<!fir.ptr<f32>>
subroutine test5
   call test5_inner
 
   if (p(1) .ne. -42.0) then
      print *, "failed"
   end if
   
 contains
   ! CHECK-LABEL: func @_QFtest5Ptest5_inner(
-  ! CHECK-SAME:%[[tup:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>> {fir.host_assoc}) {
+  ! CHECK-SAME:%[[tup:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>> {fir.host_assoc}) attributes {fir.internal_proc} {
   subroutine test5_inner
     ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>>
     ! CHECK: %[[p:.*]] = fir.load %[[ptup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>>
     ! CHECK: %[[atup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>
     ! CHECK: %[[a:.*]] = fir.load %[[atup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>
     ! CHECK: %[[abox:.*]] = fir.load %[[a]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
     ! CHECK-DAG: %[[adims:.*]]:3 = fir.box_dims %[[abox]], %c0{{.*}} : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index)
     ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[abox]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
subroutine test7(j, k)
   ! CHECK: fir.store %[[j]] to %[[jtup]] : !fir.llvm_ptr<!fir.ref<i32>>
 
   ! CHECK: %[[kelem:.*]] = fir.array_coor %[[k]] %{{.*}} : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
   ! CHECK: fir.call @_QFtest7Ptest7_inner(%[[kelem]], %[[tup]]) {{.*}}: (!fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>) -> i32
   k = test7_inner(k)
 contains
 
 ! CHECK-LABEL: func @_QFtest7Ptest7_inner(
-! CHECK-SAME: %[[i:.*]]: !fir.ref<i32>{{.*}}, %[[tup:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) -> i32 {
+! CHECK-SAME: %[[i:.*]]: !fir.ref<i32>{{.*}}, %[[tup:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) -> i32 attributes {fir.internal_proc} {
 elemental integer function test7_inner(i)
   implicit none
   integer, intent(in) :: i
   ! CHECK: %[[jtup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
   ! CHECK: %[[jptr:.*]] = fir.load %[[jtup]] : !fir.llvm_ptr<!fir.ref<i32>>
   ! CHECK-DAG: %[[iload:.*]] = fir.load %[[i]] : !fir.ref<i32>
   ! CHECK-DAG: %[[jload:.*]] = fir.load %[[jptr]] : !fir.ref<i32>
   ! CHECK: addi %[[iload]], %[[jload]] : i32
   test7_inner = i + j
 end function
 end subroutine
 
 subroutine issue990()
   ! Test that host symbols used in statement functions inside an internal
   ! procedure are correctly captured from the host.
   implicit none
   integer :: captured
   call bar()
 contains
 ! CHECK-LABEL: func @_QFissue990Pbar(
-! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) {
+! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.internal_proc} {
 subroutine bar()
   integer :: stmt_func, i
   stmt_func(i) = i + captured
   ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
   ! CHECK: %[[addr:.*]] = fir.load %[[tupAddr]] : !fir.llvm_ptr<!fir.ref<i32>>
   ! CHECK: %[[value:.*]] = fir.load %[[addr]] : !fir.ref<i32>
   ! CHECK: arith.addi %{{.*}}, %[[value]] : i32
   print *, stmt_func(10)
 end subroutine
 end subroutine
 
 subroutine issue990b()
   ! Test when an internal procedure uses a statement function from its host
   ! which uses host variables that are otherwise not used by the internal
   ! procedure.
   implicit none
   integer :: captured, captured_stmt_func, i
   captured_stmt_func(i) = i + captured
   call bar()
 contains
 ! CHECK-LABEL: func @_QFissue990bPbar(
-! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) {
+! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.internal_proc} {
 subroutine bar()
   ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
   ! CHECK: %[[addr:.*]] = fir.load %[[tupAddr]] : !fir.llvm_ptr<!fir.ref<i32>>
   ! CHECK: %[[value:.*]] = fir.load %[[addr]] : !fir.ref<i32>
   ! CHECK: arith.addi %{{.*}}, %[[value]] : i32
   print *, captured_stmt_func(10)
 end subroutine
 end subroutine
 
 ! Test capture of dummy procedure functions.
 subroutine test8(dummy_proc)
  implicit none
  interface
    real function dummy_proc(x)
     real :: x
    end function
  end interface
  call bar()
 contains
 ! CHECK-LABEL: func @_QFtest8Pbar(
-! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.boxproc<() -> ()>>> {fir.host_assoc}) {
+! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.boxproc<() -> ()>>> {fir.host_assoc}) attributes {fir.internal_proc} {
 subroutine bar()
   ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.boxproc<() -> ()>>>, i32) -> !fir.ref<!fir.boxproc<() -> ()>>
   ! CHECK: %[[dummyProc:.*]] = fir.load %[[tupAddr]] : !fir.ref<!fir.boxproc<() -> ()>>
   ! CHECK: %[[dummyProcCast:.*]] = fir.box_addr %[[dummyProc]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref<f32>) -> f32)
   ! CHECK: fir.call %[[dummyProcCast]](%{{.*}}) {{.*}}: (!fir.ref<f32>) -> f32
  print *, dummy_proc(42.)
 end subroutine
 end subroutine
 
 ! Test capture of dummy subroutines.
 subroutine test9(dummy_proc)
  implicit none
  interface
    subroutine dummy_proc()
    end subroutine
  end interface
  call bar()
 contains
 ! CHECK-LABEL: func @_QFtest9Pbar(
-! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.boxproc<() -> ()>>> {fir.host_assoc}) {
+! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.boxproc<() -> ()>>> {fir.host_assoc}) attributes {fir.internal_proc} {
 subroutine bar()
   ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.boxproc<() -> ()>>>, i32) -> !fir.ref<!fir.boxproc<() -> ()>>
   ! CHECK: %[[dummyProc:.*]] = fir.load %[[tupAddr]] : !fir.ref<!fir.boxproc<() -> ()>>
   ! CHECK: %[[pa:.*]] = fir.box_addr %[[dummyProc]]
   ! CHECK: fir.call %[[pa]]() {{.*}}: () -> ()
   call dummy_proc()
 end subroutine
 end subroutine
 
 ! Test capture of namelist
 ! CHECK-LABEL: func @_QPtest10(
 ! CHECK-SAME: %[[i:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>{{.*}}) {
 subroutine test10(i)
  implicit none
  integer, pointer :: i(:)
  namelist /a_namelist/ i
  ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup:.*]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>
  ! CHECK: fir.store %[[i]] to %[[tupAddr]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>
  ! CHECK: fir.call @_QFtest10Pbar(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>>) -> ()
  call bar()
 contains
 ! CHECK-LABEL: func @_QFtest10Pbar(
-! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>> {fir.host_assoc}) {
+! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>> {fir.host_assoc}) attributes {fir.internal_proc} {
 subroutine bar()
   ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>
   ! CHECK: fir.load %[[tupAddr]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>
   read (88, NML = a_namelist) 
 end subroutine
 end subroutine
 
 ! Test passing an internal procedure as a dummy argument.
 
 ! CHECK-LABEL: func @_QPtest_proc_dummy() {
 ! CHECK:         %[[VAL_4:.*]] = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFtest_proc_dummyEi"}
 ! CHECK:         %[[VAL_5:.*]] = fir.alloca tuple<!fir.ref<i32>>
 ! CHECK:         %[[VAL_7:.*]] = fir.address_of(@_QFtest_proc_dummyPtest_proc_dummy_a) : (!fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>) -> ()
 ! CHECK:         %[[VAL_8:.*]] = fir.emboxproc %[[VAL_7]], %[[VAL_5]] : ((!fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>) -> (), !fir.ref<tuple<!fir.ref<i32>>>) -> !fir.boxproc<() -> ()>
 ! CHECK:         fir.call @_QPtest_proc_dummy_other(%[[VAL_8]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
 
 ! CHECK-LABEL: func @_QFtest_proc_dummyPtest_proc_dummy_a(
 ! CHECK-SAME:          %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "j"},
-! CHECK-SAME:          %[[VAL_1:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) {
+! CHECK-SAME:          %[[VAL_1:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.internal_proc} {
 ! CHECK:         %[[VAL_2:.*]] = arith.constant 0 : i32
 ! CHECK:         %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
 ! CHECK:         %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.llvm_ptr<!fir.ref<i32>>
 ! CHECK:         %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
 ! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
 ! CHECK:         %[[VAL_7:.*]] = arith.addi %[[VAL_5]], %[[VAL_6]] : i32
 ! CHECK:         fir.store %[[VAL_7]] to %[[VAL_4]] : !fir.ref<i32>
 ! CHECK:         return

 ! CHECK:         fir.call @llvm.stackrestore(%[[VAL_38]]) {{.*}}: (!fir.ref<i8>) -> ()
 ! CHECK:         %[[VAL_43:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_32]]) {{.*}}: (!fir.ref<i8>) -> i32
 ! CHECK:         return
 ! CHECK:       }
 
 ! CHECK-LABEL: func @_QFtest_proc_dummy_charPgen_message(
 ! CHECK-SAME:                                            %[[VAL_0:.*]]: !fir.ref<!fir.char<1,10>>,
 ! CHECK-SAME:                                            %[[VAL_1:.*]]: index,
-! CHECK-SAME:                                            %[[VAL_2:.*]]: !fir.ref<tuple<!fir.boxchar<1>>> {fir.host_assoc}) -> !fir.boxchar<1> {
+! CHECK-SAME:                                            %[[VAL_2:.*]]: !fir.ref<tuple<!fir.boxchar<1>>> {fir.host_assoc}) -> !fir.boxchar<1> attributes {fir.internal_proc} {
 ! CHECK-DAG:         %[[VAL_3:.*]] = arith.constant 0 : i32
 ! CHECK-DAG:         %[[VAL_4:.*]] = arith.constant 10 : index
 ! CHECK-DAG:         %[[VAL_5:.*]] = arith.constant false
 ! CHECK-DAG:         %[[VAL_6:.*]] = arith.constant 1 : index
 ! CHECK-DAG:         %[[VAL_7:.*]] = arith.constant 32 : i8
 ! CHECK-DAG:         %[[VAL_8:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>>
 ! CHECK:         %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<tuple<!fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
 ! CHECK:         %[[VAL_10:.*]] = fir.load %[[VAL_9]] : !fir.ref<!fir.boxchar<1>>
 ! CHECK:         %[[VAL_11:.*]]:2 = fir.unboxchar %[[VAL_10]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>>
 ! CHECK:         %[[VAL_13:.*]] = arith.cmpi sgt, %[[VAL_11]]#1, %[[VAL_4]] : index
 ! CHECK:         %[[VAL_14:.*]] = arith.select %[[VAL_13]], %[[VAL_4]], %[[VAL_11]]#1 : index
 ! CHECK:         %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (index) -> i64
 ! CHECK:         %[[VAL_16:.*]] = fir.convert %[[VAL_12]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
 ! CHECK:         %[[VAL_17:.*]] = fir.convert %[[VAL_11]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
 ! CHECK:         fir.call @llvm.memmove.p0.p0.i64(%[[VAL_16]], %[[VAL_17]], %[[VAL_15]], %[[VAL_5]]) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
 ! CHECK:         %[[VAL_18:.*]] = fir.undefined !fir.char<1>
 ! CHECK:         %[[VAL_19:.*]] = fir.insert_value %[[VAL_18]], %[[VAL_7]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>

flang/test/Lower/polymorphic.f90

subroutine host_assoc(this)
     call internal
   contains
     subroutine internal
       print*, this%a, this%b
     end subroutine
   end subroutine
 
 ! CHECK-LABEL: func.func @_QMpolymorphic_testFhost_assocPinternal(
-! CHECK-SAME: %[[TUPLE:.*]]: !fir.ref<tuple<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {fir.host_assoc}) {
+! CHECK-SAME: %[[TUPLE:.*]]: !fir.ref<tuple<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {fir.host_assoc}) attributes {fir.internal_proc} {
 ! CHECK: %[[POS_IN_TUPLE:.*]] = arith.constant 0 : i32
 ! CHECK: %[[COORD_OF_CLASS:.*]] = fir.coordinate_of %[[TUPLE]], %[[POS_IN_TUPLE]] : (!fir.ref<tuple<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>, i32) -> !fir.ref<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>
 ! CHECK: %[[CLASS:.*]] = fir.load %[[COORD_OF_CLASS]] : !fir.ref<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>
 ! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>
 ! CHECK: %[[COORD_A:.*]] = fir.coordinate_of %[[CLASS]], %[[FIELD_A]] : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.field) -> !fir.ref<i32>
 ! CHECK: %[[A:.*]] = fir.load %[[COORD_A]] : !fir.ref<i32>
 ! CHECK: %{{.*}} = fir.call @_FortranAioOutputInteger32(%{{.*}}, %[[A]]) {{.*}} : (!fir.ref<i8>, i32) -> i1
 ! CHECK: %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>