[flang] Lower more pointer assignments/disassociation cases

[clementval]

Summary

This patch lowers more cases of pointer assignments and
disassociations.

This patch is part of the upstreaming effort from fir-dev branch.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Lower/AbstractConverter.h

public:
   //===--------------------------------------------------------------------===//
 
   /// Get the mlir instance of a symbol.
   virtual mlir::Value getSymbolAddress(SymbolRef sym) = 0;
 
   /// Get the binding of an implied do variable by name.
   virtual mlir::Value impliedDoBinding(llvm::StringRef name) = 0;
 
+  /// Copy the binding of src to target symbol.
+  virtual void copySymbolBinding(SymbolRef src, SymbolRef target) = 0;
+
+  /// Binds the symbol to an fir extended value. The symbol binding will be
+  /// added or replaced at the inner-most level of the local symbol map.
+  virtual void bindSymbol(SymbolRef sym, const fir::ExtendedValue &exval) = 0;
+
   /// Get the label set associated with a symbol.
   virtual bool lookupLabelSet(SymbolRef sym, pft::LabelSet &labelSet) = 0;
 
   /// Get the code defined by a label
   virtual pft::Evaluation *lookupLabel(pft::Label label) = 0;
 
   //===--------------------------------------------------------------------===//
   // Expressions

flang/include/flang/Lower/ConvertVariable.h

mlir::Value genInitialDataTarget(Fortran::lower::AbstractConverter &,
                                  mlir::Location, mlir::Type boxType,
                                  const SomeExpr &initialTarget);
 
 /// Generate address \p addr inside an initializer.
 fir::ExtendedValue
 genExtAddrInInitializer(Fortran::lower::AbstractConverter &converter,
                         mlir::Location loc, const SomeExpr &addr);
 
+/// Create global variable from a compiler generated object symbol that
+/// describes a derived type for the runtime.
+void createRuntimeTypeInfoGlobal(Fortran::lower::AbstractConverter &converter,
+                                 mlir::Location loc,
+                                 const Fortran::semantics::Symbol &typeInfoSym);
+
 } // namespace Fortran::lower
 #endif // FORTRAN_LOWER_CONVERT_VARIABLE_H

flang/include/flang/Lower/SymbolMap.h

public:
   }
 
   /// Find `symbol` and return its value if it appears in the current mappings.
   SymbolBox lookupSymbol(semantics::SymbolRef sym);
   SymbolBox lookupSymbol(const semantics::Symbol *sym) {
     return lookupSymbol(*sym);
   }
 
+  /// Find `symbol` and return its value if it appears in the inner-most level
+  /// map.
+  SymbolBox shallowLookupSymbol(semantics::SymbolRef sym);
+  SymbolBox shallowLookupSymbol(const semantics::Symbol *sym) {
+    return shallowLookupSymbol(*sym);
+  }
+
   /// Add a new binding from the ac-do-variable `var` to `value`.
   void pushImpliedDoBinding(AcDoVar var, mlir::Value value) {
     impliedDoStack.emplace_back(var, value);
   }
 
   /// Pop the most recent implied do binding off the stack.
   void popImpliedDoBinding() {
     assert(!impliedDoStack.empty());
public:
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &os,
                                        const SymMap &symMap);
 
   /// Dump the map. For debugging.
   LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this << '\n'; }
 
 private:
   /// Add `symbol` to the current map and bind a `box`.
-  void makeSym(semantics::SymbolRef sym, const SymbolBox &box,
+  void makeSym(semantics::SymbolRef symRef, const SymbolBox &box,
                bool force = false) {
+    const auto *sym = &symRef.get().GetUltimate();
     if (force)
-      symbolMapStack.back().erase(&*sym);
+      symbolMapStack.back().erase(sym);
     assert(box && "cannot add an undefined symbol box");
-    symbolMapStack.back().try_emplace(&*sym, box);
+    symbolMapStack.back().try_emplace(sym, box);
   }
 
   llvm::SmallVector<llvm::DenseMap<const semantics::Symbol *, SymbolBox>>
       symbolMapStack;
 
   // Implied DO induction variables are not represented as Se::Symbol in
   // Ev::Expr. Keep the variable markers in their own stack.
   llvm::SmallVector<std::pair<AcDoVar, mlir::Value>> impliedDoStack;
 };
 
 } // namespace Fortran::lower
 
 #endif // FORTRAN_LOWER_SYMBOLMAP_H

flang/lib/Lower/Bridge.cpp

 class FirConverter : public Fortran::lower::AbstractConverter {
 public:
   explicit FirConverter(Fortran::lower::LoweringBridge &bridge)
       : bridge{bridge}, foldingContext{bridge.createFoldingContext()} {}
   virtual ~FirConverter() = default;
 
   /// Convert the PFT to FIR.
   void run(Fortran::lower::pft::Program &pft) {
-    // Primary translation pass.
+    // Preliminary translation pass.
     //  - Declare all functions that have definitions so that definition
     //    signatures prevail over call site signatures.
     //  - Define module variables and OpenMP/OpenACC declarative construct so
     //    that they are available before lowering any function that may use
     //    them.
+    //  - Translate block data programs so that common block definitions with
+    //    data initializations take precedence over other definitions.
     for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
-      std::visit(Fortran::common::visitors{
-                     [&](Fortran::lower::pft::FunctionLikeUnit &f) {
-                       declareFunction(f);
-                     },
-                     [&](Fortran::lower::pft::ModuleLikeUnit &m) {
-                       lowerModuleDeclScope(m);
-                       for (Fortran::lower::pft::FunctionLikeUnit &f :
-                            m.nestedFunctions)
-                         declareFunction(f);
-                     },
-                     [&](Fortran::lower::pft::BlockDataUnit &b) {},
-                     [&](Fortran::lower::pft::CompilerDirectiveUnit &d) {
-                       setCurrentPosition(
-                           d.get<Fortran::parser::CompilerDirective>().source);
-                       mlir::emitWarning(toLocation(),
-                                         "ignoring all compiler directives");
-                     },
-                 },
-                 u);
+      std::visit(
+          Fortran::common::visitors{
+              [&](Fortran::lower::pft::BlockDataUnit &b) { lowerBlockData(b); },
+              [&](Fortran::lower::pft::CompilerDirectiveUnit &d) {},
     }
 
     // Primary translation pass.
     for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
       std::visit(
           Fortran::common::visitors{
               [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); },
               [&](Fortran::lower::pft::ModuleLikeUnit &m) { lowerMod(m); },
public:
 
   mlir::Value impliedDoBinding(llvm::StringRef name) override final {
     mlir::Value val = localSymbols.lookupImpliedDo(name);
     if (!val)
       fir::emitFatalError(toLocation(), "ac-do-variable has no binding");
     return val;
   }
 
+  void copySymbolBinding(Fortran::lower::SymbolRef src,
+                         Fortran::lower::SymbolRef target) override final {
+    localSymbols.addSymbol(target, lookupSymbol(src).toExtendedValue());
+  }
+
+  /// Add the symbol binding to the inner-most level of the symbol map and
+  /// return true if it is not already present. Otherwise, return false.
+  bool bindIfNewSymbol(Fortran::lower::SymbolRef sym,
+                       const fir::ExtendedValue &exval) {
+    if (shallowLookupSymbol(sym))
+      return false;
+    bindSymbol(sym, exval);
+    return true;
+  }
+
+  void bindSymbol(Fortran::lower::SymbolRef sym,
+                  const fir::ExtendedValue &exval) override final {
+    localSymbols.addSymbol(sym, exval, /*forced=*/true);
+  }
+
   bool lookupLabelSet(Fortran::lower::SymbolRef sym,
                       Fortran::lower::pft::LabelSet &labelSet) override final {
     Fortran::lower::pft::FunctionLikeUnit &owningProc =
         *getEval().getOwningProcedure();
     auto iter = owningProc.assignSymbolLabelMap.find(sym);
     if (iter == owningProc.assignSymbolLabelMap.end())
       return false;
     labelSet = iter->second;
void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
     (void)mlir::simplifyRegions(rewriter,
                                 {builder->getRegion()}); // remove dead code
     delete builder;
     builder = nullptr;
     hostAssocTuple = mlir::Value{};
     localSymbols.clear();
   }
 
+  /// Helper to generate GlobalOps when the builder is not positioned in any
+  /// region block. This is required because the FirOpBuilder assumes it is
+  /// always positioned inside a region block when creating globals, the easiest
+  /// way comply is to create a dummy function and to throw it afterwards.
+  void createGlobalOutsideOfFunctionLowering(
+      const std::function<void()> &createGlobals) {
+    // FIXME: get rid of the bogus function context and instantiate the
+    // globals directly into the module.
+    MLIRContext *context = &getMLIRContext();
+    mlir::FuncOp func = fir::FirOpBuilder::createFunction(
+        mlir::UnknownLoc::get(context), getModuleOp(),
+        fir::NameUniquer::doGenerated("Sham"),
+        mlir::FunctionType::get(context, llvm::None, llvm::None));
+    func.addEntryBlock();
+    builder = new fir::FirOpBuilder(func, bridge.getKindMap());
+    createGlobals();
+    if (mlir::Region *region = func.getCallableRegion())
+      region->dropAllReferences();
+    func.erase();
+    delete builder;
+    builder = nullptr;
+    localSymbols.clear();
+  }
+  /// Instantiate the data from a BLOCK DATA unit.
+  void lowerBlockData(Fortran::lower::pft::BlockDataUnit &bdunit) {
+    createGlobalOutsideOfFunctionLowering([&]() {
+      Fortran::lower::AggregateStoreMap fakeMap;
+      for (const auto &[_, sym] : bdunit.symTab) {
+        if (sym->has<Fortran::semantics::ObjectEntityDetails>()) {
+          Fortran::lower::pft::Variable var(*sym, true);
+          instantiateVar(var, fakeMap);
+        }
+      }
+    });
+  }
+
   /// Map mlir function block arguments to the corresponding Fortran dummy
   /// variables. When the result is passed as a hidden argument, the Fortran
   /// result is also mapped. The symbol map is used to hold this mapping.
   void mapDummiesAndResults(Fortran::lower::pft::FunctionLikeUnit &funit,
                             const Fortran::lower::CalleeInterface &callee) {
     assert(builder && "require a builder object at this point");
     using PassBy = Fortran::lower::CalleeInterface::PassEntityBy;
     auto mapPassedEntity = [&](const auto arg) -> void {
void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) {
     funit.setActiveEntry(0);
     for (Fortran::lower::pft::FunctionLikeUnit &f : funit.nestedFunctions)
       lowerFunc(f); // internal procedure
   }
 
   /// Lower module variable definitions to fir::globalOp and OpenMP/OpenACC
   /// declarative construct.
   void lowerModuleDeclScope(Fortran::lower::pft::ModuleLikeUnit &mod) {
-    // FIXME: get rid of the bogus function context and instantiate the
-    // globals directly into the module.
-    MLIRContext *context = &getMLIRContext();
     setCurrentPosition(mod.getStartingSourceLoc());
-    mlir::FuncOp func = fir::FirOpBuilder::createFunction(
-        mlir::UnknownLoc::get(context), getModuleOp(),
-        fir::NameUniquer::doGenerated("ModuleSham"),
-        mlir::FunctionType::get(context, llvm::None, llvm::None));
-    func.addEntryBlock();
-    builder = new fir::FirOpBuilder(func, bridge.getKindMap());
+    createGlobalOutsideOfFunctionLowering([&]() {
       for (const Fortran::lower::pft::Variable &var :
            mod.getOrderedSymbolTable()) {
         // Only define the variables owned by this module.
         const Fortran::semantics::Scope *owningScope = var.getOwningScope();
         if (!owningScope || mod.getScope() == *owningScope)
           Fortran::lower::defineModuleVariable(*this, var);
       }
       for (auto &eval : mod.evaluationList)
         genFIR(eval);
-    if (mlir::Region *region = func.getCallableRegion())
-      region->dropAllReferences();
-    func.erase();
-    delete builder;
-    builder = nullptr;
+    });
   }
 
   /// Lower functions contained in a module.
   void lowerMod(Fortran::lower::pft::ModuleLikeUnit &mod) {
     for (Fortran::lower::pft::FunctionLikeUnit &f : mod.nestedFunctions)
       lowerFunc(f);
   }
 
private:
   /// Find the symbol in the local map or return null.
   Fortran::lower::SymbolBox
   lookupSymbol(const Fortran::semantics::Symbol &sym) {
     if (Fortran::lower::SymbolBox v = localSymbols.lookupSymbol(sym))
       return v;
     return {};
   }
 
+  /// Find the symbol in the inner-most level of the local map or return null.
+  Fortran::lower::SymbolBox
+  shallowLookupSymbol(const Fortran::semantics::Symbol &sym) {
+    if (Fortran::lower::SymbolBox v = localSymbols.shallowLookupSymbol(sym))
+      return v;
+    return {};
+  }
+
   /// Add the symbol to the local map and return `true`. If the symbol is
   /// already in the map and \p forced is `false`, the map is not updated.
   /// Instead the value `false` is returned.
   bool addSymbol(const Fortran::semantics::SymbolRef sym, mlir::Value val,
                  bool forced = false) {
     if (!forced && lookupSymbol(sym))
       return false;
     localSymbols.addSymbol(sym, val, forced);

flang/lib/Lower/ConvertExpr.cpp

 // there for more information on these data structures. Generally speaking,
 // these data structures are a strongly typed family of abstract data types
 // that, composed as trees, describe the syntax of Fortran expressions.
 //
 // This part of the bridge can traverse these tree structures and lower them
 // to the correct FIR representation in SSA form.
 //===----------------------------------------------------------------------===//
 
+static llvm::cl::opt<bool> generateArrayCoordinate(
+    "gen-array-coor",
+    llvm::cl::desc("in lowering create ArrayCoorOp instead of CoordinateOp"),
+    llvm::cl::init(false));
+
 // The default attempts to balance a modest allocation size with expected user
 // input to minimize bounds checks and reallocations during dynamic array
 // construction. Some user codes may have very large array constructors for
 // which the default can be increased.
 static llvm::cl::opt<unsigned> clInitialBufferSize(
     "array-constructor-initial-buffer-size",
     llvm::cl::desc(
         "set the incremental array construction buffer size (default=32)"),
createInMemoryScalarCopy(fir::FirOpBuilder &builder, mlir::Location loc,
   if (fir::isDerivedWithLengthParameters(exv))
     TODO(loc, "copy derived type with length parameters");
   mlir::Type type = fir::unwrapPassByRefType(fir::getBase(exv).getType());
   fir::ExtendedValue temp = builder.createTemporary(loc, type);
   fir::factory::genScalarAssignment(builder, loc, temp, exv);
   return temp;
 }
 
+// An expression with non-zero rank is an array expression.
+template <typename A>
+static bool isArray(const A &x) {
+  return x.Rank() != 0;
+}
+
 /// Is this a variable wrapped in parentheses?
 template <typename A>
 static bool isParenthesizedVariable(const A &) {
   return false;
 }
 template <typename T>
 static bool isParenthesizedVariable(const Fortran::evaluate::Expr<T> &expr) {
   using ExprVariant = decltype(Fortran::evaluate::Expr<T>::u);
if (auto host = argumentHostAssocs(converter, funcAddr))
       return builder.create<fir::EmboxProcOp>(
           loc, boxTy, llvm::ArrayRef<mlir::Value>{funcAddr, host});
     return builder.create<fir::EmboxProcOp>(loc, boxTy, funcAddr);
   }();
   return fir::factory::createCharacterProcedureTuple(builder, loc, argTy,
                                                      boxProc, charLen);
 }
 
+// Helper to get the ultimate first symbol. This works around the fact that
+// symbol resolution in the front end doesn't always resolve a symbol to its
+// ultimate symbol but may leave placeholder indirections for use and host
+// associations.
+template <typename A>
+const Fortran::semantics::Symbol &getFirstSym(const A &obj) {
+  return obj.GetFirstSymbol().GetUltimate();
+}
+
+// Helper to get the ultimate last symbol.
+template <typename A>
+const Fortran::semantics::Symbol &getLastSym(const A &obj) {
+  return obj.GetLastSymbol().GetUltimate();
+}
+
 namespace {
 
 /// Lowering of Fortran::evaluate::Expr<T> expressions
 class ScalarExprLowering {
 public:
   using ExtValue = fir::ExtendedValue;
 
   explicit ScalarExprLowering(mlir::Location loc,
ExtValue gen(Fortran::semantics::SymbolRef sym) {
     if (Fortran::lower::SymbolBox val = symMap.lookupSymbol(sym))
       return val.match(
           [&](const Fortran::lower::SymbolBox::PointerOrAllocatable &boxAddr) {
             return fir::factory::genMutableBoxRead(builder, getLoc(), boxAddr);
           },
           [&val](auto &) { return val.toExtendedValue(); });
     LLVM_DEBUG(llvm::dbgs()
                << "unknown symbol: " << sym << "\nmap: " << symMap << '\n');
-    llvm::errs() << "SYM: " << sym << "\n";
     fir::emitFatalError(getLoc(), "symbol is not mapped to any IR value");
   }
 
   ExtValue genLoad(const ExtValue &exv) {
     return ::genLoad(builder, getLoc(), exv);
   }
 
   ExtValue genval(Fortran::semantics::SymbolRef sym) {
+    mlir::Location loc = getLoc();
     ExtValue var = gen(sym);
     if (const fir::UnboxedValue *s = var.getUnboxed())
-      if (fir::isReferenceLike(s->getType()))
-        return genLoad(*s);
+      if (fir::isReferenceLike(s->getType())) {
+        // A function with multiple entry points returning different types
+        // tags all result variables with one of the largest types to allow
+        // them to share the same storage.  A reference to a result variable
+        // of one of the other types requires conversion to the actual type.
+        fir::UnboxedValue addr = *s;
+        if (Fortran::semantics::IsFunctionResult(sym)) {
+          mlir::Type resultType = converter.genType(*sym);
+          if (addr.getType() != resultType)
+            addr = builder.createConvert(loc, builder.getRefType(resultType),
+                                         addr);
+        }
+        return genLoad(addr);
+      }
     return var;
   }
 
   ExtValue genval(const Fortran::evaluate::BOZLiteralConstant &) {
     TODO(getLoc(), "genval BOZ");
   }
 
   /// Return indirection to function designated in ProcedureDesignator.
public:
   }
 
   /// Lowering of an <i>ac-do-variable</i>, which is not a Symbol.
   ExtValue genval(const Fortran::evaluate::ImpliedDoIndex &var) {
     return converter.impliedDoBinding(toStringRef(var.name));
   }
 
   ExtValue genval(const Fortran::evaluate::DescriptorInquiry &desc) {
-    ExtValue exv = desc.base().IsSymbol() ? gen(desc.base().GetLastSymbol())
+    ExtValue exv = desc.base().IsSymbol() ? gen(getLastSym(desc.base()))
                                           : gen(desc.base().GetComponent());
     mlir::IndexType idxTy = builder.getIndexType();
     mlir::Location loc = getLoc();
     auto castResult = [&](mlir::Value v) {
       using ResTy = Fortran::evaluate::DescriptorInquiry::Result;
       return builder.createConvert(
           loc, converter.genType(ResTy::category, ResTy::kind), v);
     };
#define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp)                           \
   /// MIN and MAX operations
   template <Fortran::common::TypeCategory TC, int KIND>
   ExtValue
   genval(const Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>>
              &op) {
     TODO(getLoc(), "genval Extremum<TC, KIND>");
   }
 
+  // Change the dynamic length information without actually changing the
+  // underlying character storage.
+  fir::ExtendedValue
+  replaceScalarCharacterLength(const fir::ExtendedValue &scalarChar,
+                               mlir::Value newLenValue) {
+    mlir::Location loc = getLoc();
+    const fir::CharBoxValue *charBox = scalarChar.getCharBox();
+    if (!charBox)
+      fir::emitFatalError(loc, "expected scalar character");
+    mlir::Value charAddr = charBox->getAddr();
+    auto charType =
+        fir::unwrapPassByRefType(charAddr.getType()).cast<fir::CharacterType>();
+    if (charType.hasConstantLen()) {
+      // Erase previous constant length from the base type.
+      fir::CharacterType::LenType newLen = fir::CharacterType::unknownLen();
+      mlir::Type newCharTy = fir::CharacterType::get(
+          builder.getContext(), charType.getFKind(), newLen);
+      mlir::Type newType = fir::ReferenceType::get(newCharTy);
+      charAddr = builder.createConvert(loc, newType, charAddr);
+      return fir::CharBoxValue{charAddr, newLenValue};
+    }
+    return fir::CharBoxValue{charAddr, newLenValue};
+  }
+
   template <int KIND>
   ExtValue genval(const Fortran::evaluate::SetLength<KIND> &x) {
     TODO(getLoc(), "genval SetLength<KIND>");
   }
 
   template <int KIND>
   ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
                       Fortran::common::TypeCategory::Integer, KIND>> &op) {
if constexpr (TC == Fortran::common::TypeCategory::Integer) {
       inInitializer->rawVals.push_back(val);
       llvm::APFloat imgVal{builder.getKindMap().getFloatSemantics(KIND),
                            strImg};
       val = builder.getFloatAttr(inInitializer->rawType, imgVal);
     }
     inInitializer->rawVals.push_back(val);
   }
 
-  /// Convert a ascii scalar literal CHARACTER to IR. (specialization)
+  /// Convert a scalar literal CHARACTER to IR.
+  template <int KIND>
   ExtValue
-  genAsciiScalarLit(const Fortran::evaluate::Scalar<Fortran::evaluate::Type<
-                        Fortran::common::TypeCategory::Character, 1>> &value,
-                    int64_t len) {
+  genScalarLit(const Fortran::evaluate::Scalar<Fortran::evaluate::Type<
+                   Fortran::common::TypeCategory::Character, KIND>> &value,
+    using ET = typename std::decay_t<decltype(value)>::value_type;
+    if constexpr (KIND == 1) {
       assert(value.size() == static_cast<std::uint64_t>(len));
       // Outline character constant in ro data if it is not in an initializer.
       if (!inInitializer)
         return fir::factory::createStringLiteral(builder, getLoc(), value);
       // When in an initializer context, construct the literal op itself and do
       // not construct another constant object in rodata.
       fir::StringLitOp stringLit = builder.createStringLitOp(getLoc(), value);
       mlir::Value lenp = builder.createIntegerConstant(
           getLoc(), builder.getCharacterLengthType(), len);
       return fir::CharBoxValue{stringLit.getResult(), lenp};
     }
-  /// Convert a non ascii scalar literal CHARACTER to IR. (specialization)
-  template <int KIND>
-  ExtValue
-  genScalarLit(const Fortran::evaluate::Scalar<Fortran::evaluate::Type<
-                   Fortran::common::TypeCategory::Character, KIND>> &value,
-               int64_t len) {
-    using ET = typename std::decay_t<decltype(value)>::value_type;
-    if constexpr (KIND == 1) {
-      return genAsciiScalarLit(value, len);
-    }
     fir::CharacterType type =
         fir::CharacterType::get(builder.getContext(), KIND, len);
     auto consLit = [&]() -> fir::StringLitOp {
       mlir::MLIRContext *context = builder.getContext();
       std::int64_t size = static_cast<std::int64_t>(value.size());
-      mlir::ShapedType shape = mlir::VectorType::get(
+      mlir::ShapedType shape = mlir::RankedTensorType::get(
           llvm::ArrayRef<std::int64_t>{size},
           mlir::IntegerType::get(builder.getContext(), sizeof(ET) * 8));
-      auto strAttr = mlir::DenseElementsAttr::get(
+      auto denseAttr = mlir::DenseElementsAttr::get(
           shape, llvm::ArrayRef<ET>{value.data(), value.size()});
-      auto valTag = mlir::StringAttr::get(context, fir::StringLitOp::value());
-      mlir::NamedAttribute dataAttr(valTag, strAttr);
+      auto denseTag = mlir::StringAttr::get(context, fir::StringLitOp::xlist());
+      mlir::NamedAttribute dataAttr(denseTag, denseAttr);
       auto sizeTag = mlir::StringAttr::get(context, fir::StringLitOp::size());
       mlir::NamedAttribute sizeAttr(sizeTag, builder.getI64IntegerAttr(len));
       llvm::SmallVector<mlir::NamedAttribute> attrs = {dataAttr, sizeAttr};
       return builder.create<fir::StringLitOp>(
           getLoc(), llvm::ArrayRef<mlir::Type>{type}, llvm::None, attrs);
     };
 
     mlir::Value lenp = builder.createIntegerConstant(
         getLoc(), builder.getCharacterLengthType(), len);
     // When in an initializer context, construct the literal op itself and do
     // not construct another constant object in rodata.
     if (inInitializer)
       return fir::CharBoxValue{consLit().getResult(), lenp};
 
     // Otherwise, the string is in a plain old expression so "outline" the value
     // by hashconsing it to a constant literal object.
 
-    // FIXME: For wider char types, lowering ought to use an array of i16 or
-    // i32. But for now, lowering just fakes that the string value is a range of
-    // i8 to get it past the C++ compiler.
     std::string globalName =
         fir::factory::uniqueCGIdent("cl", (const char *)value.c_str());
     fir::GlobalOp global = builder.getNamedGlobal(globalName);
     if (!global)
       global = builder.createGlobalConstant(
           getLoc(), type, globalName,
           [&](fir::FirOpBuilder &builder) {
             fir::StringLitOp str = consLit();
#define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp)                           \
 
   ExtValue gen(const Fortran::evaluate::ComplexPart &x) {
     TODO(getLoc(), "gen ComplexPart");
   }
   ExtValue genval(const Fortran::evaluate::ComplexPart &x) {
     TODO(getLoc(), "genval ComplexPart");
   }
 
+  /// Reference to a substring.
   ExtValue gen(const Fortran::evaluate::Substring &s) {
-    TODO(getLoc(), "gen Substring");
+    // Get base string
+    auto baseString = std::visit(
+        Fortran::common::visitors{
+            [&](const Fortran::evaluate::DataRef &x) { return gen(x); },
+            [&](const Fortran::evaluate::StaticDataObject::Pointer &p)
+                -> ExtValue {
+              if (std::optional<std::string> str = p->AsString())
+                return fir::factory::createStringLiteral(builder, getLoc(),
+                                                         *str);
+              // TODO: convert StaticDataObject to Constant<T> and use normal
+              // constant path. Beware that StaticDataObject data() takes into
+              // account build machine endianness.
+              TODO(getLoc(),
+                   "StaticDataObject::Pointer substring with kind > 1");
+            },
+        },
+        s.parent());
+    llvm::SmallVector<mlir::Value> bounds;
+    mlir::Value lower = genunbox(s.lower());
+    bounds.push_back(lower);
+    if (Fortran::evaluate::MaybeExtentExpr upperBound = s.upper()) {
+      mlir::Value upper = genunbox(*upperBound);
+      bounds.push_back(upper);
+    }
+    fir::factory::CharacterExprHelper charHelper{builder, getLoc()};
+    return baseString.match(
+        [&](const fir::CharBoxValue &x) -> ExtValue {
+          return charHelper.createSubstring(x, bounds);
+        },
+        [&](const fir::CharArrayBoxValue &) -> ExtValue {
+          fir::emitFatalError(
+              getLoc(),
+              "array substring should be handled in array expression");
+        },
+        [&](const auto &) -> ExtValue {
+          fir::emitFatalError(getLoc(), "substring base is not a CharBox");
+        });
   }
+
+  /// The value of a substring.
   ExtValue genval(const Fortran::evaluate::Substring &ss) {
-    TODO(getLoc(), "genval Substring");
+    // FIXME: why is the value of a substring being lowered the same as the
+    // address of a substring?
+    return gen(ss);
   }
 
   ExtValue genval(const Fortran::evaluate::Subscript &subs) {
     if (auto *s = std::get_if<Fortran::evaluate::IndirectSubscriptIntegerExpr>(
             &subs.u)) {
       if (s->value().Rank() > 0)
         fir::emitFatalError(getLoc(), "vector subscript is not scalar");
       return {genval(s->value())};
return array.match(
           fir::emitFatalError(
               loc, "internal: BoxValue in dim-collapsed fir.coordinate_of");
         },
         [&](const auto &) -> ExtValue {
           fir::emitFatalError(loc, "internal: array lowering failed");
         });
   }
 
+  /// Lower an ArrayRef to a fir.array_coor.
+  ExtValue genArrayCoorOp(const ExtValue &exv,
+                          const Fortran::evaluate::ArrayRef &aref) {
+    mlir::Location loc = getLoc();
+    mlir::Value addr = fir::getBase(exv);
+    mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(addr.getType());
+    mlir::Type eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
+    mlir::Type refTy = builder.getRefType(eleTy);
+    mlir::IndexType idxTy = builder.getIndexType();
+    llvm::SmallVector<mlir::Value> arrayCoorArgs;
+    // The ArrayRef is expected to be scalar here, arrays are handled in array
+    // expression lowering. So no vector subscript or triplet is expected here.
+    for (const auto &sub : aref.subscript()) {
+      ExtValue subVal = genSubscript(sub);
+      assert(fir::isUnboxedValue(subVal));
+      arrayCoorArgs.push_back(
+          builder.createConvert(loc, idxTy, fir::getBase(subVal)));
+    }
+    mlir::Value shape = builder.createShape(loc, exv);
+    mlir::Value elementAddr = builder.create<fir::ArrayCoorOp>(
+        loc, refTy, addr, shape, /*slice=*/mlir::Value{}, arrayCoorArgs,
+        fir::getTypeParams(exv));
+    return fir::factory::arrayElementToExtendedValue(builder, loc, exv,
+                                                     elementAddr);
+  }
+
+  /// Return the coordinate of the array reference.
   ExtValue gen(const Fortran::evaluate::ArrayRef &aref) {
-    ExtValue base = aref.base().IsSymbol() ? gen(aref.base().GetFirstSymbol())
+    ExtValue base = aref.base().IsSymbol() ? gen(getFirstSym(aref.base()))
                                            : gen(aref.base().GetComponent());
+    // Check for command-line override to use array_coor op.
+    if (generateArrayCoordinate)
+      return genArrayCoorOp(base, aref);
+    // Otherwise, use coordinate_of op.
     return genCoordinateOp(base, aref);
   }
+
   ExtValue genval(const Fortran::evaluate::ArrayRef &aref) {
     return genLoad(gen(aref));
   }
 
   ExtValue gen(const Fortran::evaluate::CoarrayRef &coref) {
     TODO(getLoc(), "gen CoarrayRef");
   }
   ExtValue genval(const Fortran::evaluate::CoarrayRef &coref) {
#define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp)                           \
   static bool
   isStatementFunctionCall(const Fortran::evaluate::ProcedureRef &procRef) {
     if (const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol())
       if (const auto *details =
               symbol->detailsIf<Fortran::semantics::SubprogramDetails>())
         return details->stmtFunction().has_value();
     return false;
   }
+  /// Generate Statement function calls
+  ExtValue genStmtFunctionRef(const Fortran::evaluate::ProcedureRef &procRef) {
+    const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol();
+    assert(symbol && "expected symbol in ProcedureRef of statement functions");
+    const auto &details = symbol->get<Fortran::semantics::SubprogramDetails>();
+
+    // Statement functions have their own scope, we just need to associate
+    // the dummy symbols to argument expressions. They are no
+    // optional/alternate return arguments. Statement functions cannot be
+    // recursive (directly or indirectly) so it is safe to add dummy symbols to
+    // the local map here.
+    symMap.pushScope();
+    for (auto [arg, bind] :
+         llvm::zip(details.dummyArgs(), procRef.arguments())) {
+      assert(arg && "alternate return in statement function");
+      assert(bind && "optional argument in statement function");
+      const auto *expr = bind->UnwrapExpr();
+      // TODO: assumed type in statement function, that surprisingly seems
+      // allowed, probably because nobody thought of restricting this usage.
+      // gfortran/ifort compiles this.
+      assert(expr && "assumed type used as statement function argument");
+      // As per Fortran 2018 C1580, statement function arguments can only be
+      // scalars, so just pass the box with the address. The only care is to
+      // to use the dummy character explicit length if any instead of the
+      // actual argument length (that can be bigger).
+      if (const Fortran::semantics::DeclTypeSpec *type = arg->GetType())
+        if (type->category() == Fortran::semantics::DeclTypeSpec::Character)
+          if (const Fortran::semantics::MaybeIntExpr &lenExpr =
+                  type->characterTypeSpec().length().GetExplicit()) {
+            mlir::Value len = fir::getBase(genval(*lenExpr));
+            // F2018 7.4.4.2 point 5.
+            len = Fortran::lower::genMaxWithZero(builder, getLoc(), len);
+            symMap.addSymbol(*arg,
+                             replaceScalarCharacterLength(gen(*expr), len));
+            continue;
+          }
+      symMap.addSymbol(*arg, gen(*expr));
+    }
+
+    // Explicitly map statement function host associated symbols to their
+    // parent scope lowered symbol box.
+    for (const Fortran::semantics::SymbolRef &sym :
+         Fortran::evaluate::CollectSymbols(*details.stmtFunction()))
+      if (const auto *details =
+              sym->detailsIf<Fortran::semantics::HostAssocDetails>())
+        if (!symMap.lookupSymbol(*sym))
+          symMap.addSymbol(*sym, gen(details->symbol()));
+
+    ExtValue result = genval(details.stmtFunction().value());
+    LLVM_DEBUG(llvm::dbgs() << "stmt-function: " << result << '\n');
+    symMap.popScope();
+    return result;
+  }
 
   /// Helper to package a Value and its properties into an ExtendedValue.
   static ExtValue toExtendedValue(mlir::Location loc, mlir::Value base,
                                   llvm::ArrayRef<mlir::Value> extents,
                                   llvm::ArrayRef<mlir::Value> lengths) {
     mlir::Type type = base.getType();
     if (type.isa<fir::BoxType>())
       return fir::BoxValue(base, /*lbounds=*/{}, lengths, extents);
mlir::Value addr =
             .getResults()[0];
     // Associate the temp address with actualArg lengths and extents.
     fir::ExtendedValue temp = fir::substBase(readIfBoxValue(actualArg), addr);
     copyOutPairs.emplace_back(CopyOutPair{
         actualArg, temp, arg.mayBeModifiedByCall(), restrictCopyAtRuntime});
     return temp;
   }
 
+  /// Generate copy-out if needed and free the temporary for an argument that
+  /// has been copied-in into a contiguous temp.
+  void genCopyOut(const CopyOutPair &copyOutPair) {
+    mlir::Location loc = getLoc();
+    if (!copyOutPair.restrictCopyAndFreeAtRuntime) {
+      if (copyOutPair.argMayBeModifiedByCall)
+        genArrayCopy(copyOutPair.var, copyOutPair.temp);
+      builder.create<fir::FreeMemOp>(loc, fir::getBase(copyOutPair.temp));
+      return;
+    }
+    builder.genIfThen(loc, *copyOutPair.restrictCopyAndFreeAtRuntime)
+        .genThen([&]() {
+          if (copyOutPair.argMayBeModifiedByCall)
+            genArrayCopy(copyOutPair.var, copyOutPair.temp);
+          builder.create<fir::FreeMemOp>(loc, fir::getBase(copyOutPair.temp));
+        })
+        .end();
+  }
+
   /// Lower a non-elemental procedure reference.
   ExtValue genRawProcedureRef(const Fortran::evaluate::ProcedureRef &procRef,
                               llvm::Optional<mlir::Type> resultType) {
     mlir::Location loc = getLoc();
     if (isElementalProcWithArrayArgs(procRef))
       fir::emitFatalError(loc, "trying to lower elemental procedure with array "
                                "arguments as normal procedure");
     if (const Fortran::evaluate::SpecificIntrinsic *intrinsic =
             procRef.proc().GetSpecificIntrinsic())
       return genIntrinsicRef(procRef, *intrinsic, resultType);
 
     if (isStatementFunctionCall(procRef))
-      TODO(loc, "Lower statement function call");
+      return genStmtFunctionRef(procRef);
 
     Fortran::lower::CallerInterface caller(procRef, converter);
     using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
 
     llvm::SmallVector<fir::MutableBoxValue> mutableModifiedByCall;
     // List of <var, temp> where temp must be copied into var after the call.
     CopyOutPairs copyOutPairs;
 
for (const Fortran::lower::CallInterface<
         mlir::Value irBox =
             fir::factory::getMutableIRBox(builder, loc, mutableBox);
         caller.placeInput(arg, irBox);
         if (arg.mayBeModifiedByCall())
           mutableModifiedByCall.emplace_back(std::move(mutableBox));
         continue;
       }
       const bool actualArgIsVariable = Fortran::evaluate::IsVariable(*expr);
+      if (arg.passBy == PassBy::BaseAddressValueAttribute) {
+        mlir::Value temp;
+        if (isArray(*expr)) {
+          auto val = genBoxArg(*expr);
+          if (!actualArgIsVariable)
+            temp = getBase(val);
+          else {
+            ExtValue copy = genArrayTempFromMold(val, ".copy");
+            genArrayCopy(copy, val);
+            temp = fir::getBase(copy);
+          }
+        } else {
+          mlir::Value val = fir::getBase(genval(*expr));
+          temp = builder.createTemporary(
+              loc, val.getType(),
+              llvm::ArrayRef<mlir::NamedAttribute>{
+                  Fortran::lower::getAdaptToByRefAttr(builder)});
+          builder.create<fir::StoreOp>(loc, val, temp);
+        }
+        caller.placeInput(arg, temp);
+        continue;
+      }
       if (arg.passBy == PassBy::BaseAddress || arg.passBy == PassBy::BoxChar) {
         const bool actualIsSimplyContiguous =
             !actualArgIsVariable || Fortran::evaluate::IsSimplyContiguous(
                                         *expr, converter.getFoldingContext());
         auto argAddr = [&]() -> ExtValue {
           ExtValue baseAddr;
           if (actualArgIsVariable && arg.isOptional()) {
             if (Fortran::evaluate::IsAllocatableOrPointerObject(
                     *expr, converter.getFoldingContext())) {
-              TODO(loc, "Allocatable or pointer argument");
+              // Fortran 2018 15.5.2.12 point 1: If unallocated/disassociated,
+              // it is as if the argument was absent. The main care here is to
+              // not do a copy-in/copy-out because the temp address, even though
+              // pointing to a null size storage, would not be a nullptr and
+              // therefore the argument would not be considered absent on the
+              // callee side. Note: if wholeSymbol is optional, it cannot be
+              // absent as per 15.5.2.12 point 7. and 8. We rely on this to
+              // un-conditionally read the allocatable/pointer descriptor here.
+              if (actualIsSimplyContiguous)
+                return genBoxArg(*expr);
+              fir::MutableBoxValue mutableBox = genMutableBoxValue(*expr);
+              mlir::Value isAssociated =
+                  fir::factory::genIsAllocatedOrAssociatedTest(builder, loc,
+                                                               mutableBox);
+              fir::ExtendedValue actualExv =
+                  fir::factory::genMutableBoxRead(builder, loc, mutableBox);
+              return genCopyIn(actualExv, arg, copyOutPairs, isAssociated);
             }
             if (const Fortran::semantics::Symbol *wholeSymbol =
                     Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(
                         *expr))
               if (Fortran::semantics::IsOptional(*wholeSymbol)) {
-                TODO(loc, "procedureref optional arg");
+                ExtValue actualArg = gen(*expr);
+                mlir::Value actualArgBase = fir::getBase(actualArg);
+                if (!actualArgBase.getType().isa<fir::BoxType>())
+                  return actualArg;
+                // Do not read wholeSymbol descriptor that may be a nullptr in
+                // case wholeSymbol is absent.
+                // Absent descriptor cannot be read. To avoid any issue in
+                // copy-in/copy-out, and when retrieving the address/length
+                // create an descriptor pointing to a null address here if the
+                // fir.box is absent.
+                mlir::Value isPresent = builder.create<fir::IsPresentOp>(
+                    loc, builder.getI1Type(), actualArgBase);
+                mlir::Type boxType = actualArgBase.getType();
+                mlir::Value emptyBox = fir::factory::createUnallocatedBox(
+                    builder, loc, boxType, llvm::None);
+                auto safeToReadBox = builder.create<mlir::arith::SelectOp>(
+                    loc, isPresent, actualArgBase, emptyBox);
+                fir::ExtendedValue safeToReadExv =
+                    fir::substBase(actualArg, safeToReadBox);
+                if (actualIsSimplyContiguous)
+                  return safeToReadExv;
+                return genCopyIn(safeToReadExv, arg, copyOutPairs, isPresent);
               }
             // Fall through: The actual argument can safely be
             // copied-in/copied-out without any care if needed.
           }
           if (actualArgIsVariable && expr->Rank() > 0) {
             ExtValue box = genBoxArg(*expr);
             if (!actualIsSimplyContiguous)
               return genCopyIn(box, arg, copyOutPairs,
for (const Fortran::lower::CallInterface<
       } else if (arg.passBy == PassBy::Box) {
         // Before lowering to an address, handle the allocatable/pointer actual
         // argument to optional fir.box dummy. It is legal to pass
         // unallocated/disassociated entity to an optional. In this case, an
         // absent fir.box must be created instead of a fir.box with a null value
         // (Fortran 2018 15.5.2.12 point 1).
         if (arg.isOptional() && Fortran::evaluate::IsAllocatableOrPointerObject(
                                     *expr, converter.getFoldingContext())) {
-          TODO(loc, "optional allocatable or pointer argument");
+          // Note that passing an absent allocatable to a non-allocatable
+          // optional dummy argument is illegal (15.5.2.12 point 3 (8)). So
+          // nothing has to be done to generate an absent argument in this case,
+          // and it is OK to unconditionally read the mutable box here.
+          fir::MutableBoxValue mutableBox = genMutableBoxValue(*expr);
+          mlir::Value isAllocated =
+              fir::factory::genIsAllocatedOrAssociatedTest(builder, loc,
+                                                           mutableBox);
+          auto absent = builder.create<fir::AbsentOp>(loc, argTy);
+          /// For now, assume it is not OK to pass the allocatable/pointer
+          /// descriptor to a non pointer/allocatable dummy. That is a strict
+          /// interpretation of 18.3.6 point 4 that stipulates the descriptor
+          /// has the dummy attributes in BIND(C) contexts.
+          mlir::Value box = builder.createBox(
+              loc, fir::factory::genMutableBoxRead(builder, loc, mutableBox));
+          // Need the box types to be exactly similar for the selectOp.
+          mlir::Value convertedBox = builder.createConvert(loc, argTy, box);
+          caller.placeInput(arg, builder.create<mlir::arith::SelectOp>(
+                                     loc, isAllocated, convertedBox, absent));
         } else {
           // Make sure a variable address is only passed if the expression is
           // actually a variable.
           mlir::Value box =
               actualArgIsVariable
                   ? builder.createBox(loc, genBoxArg(*expr))
                   : builder.createBox(getLoc(), genTempExtAddr(*expr));
           caller.placeInput(arg, box);
         }
       } else if (arg.passBy == PassBy::AddressAndLength) {
         ExtValue argRef = genExtAddr(*expr);
         caller.placeAddressAndLengthInput(arg, fir::getBase(argRef),
                                           fir::getLen(argRef));
       } else if (arg.passBy == PassBy::CharProcTuple) {
-        TODO(loc, "procedureref CharProcTuple");
+        ExtValue argRef = genExtAddr(*expr);
+        mlir::Value tuple = createBoxProcCharTuple(
+            converter, argTy, fir::getBase(argRef), fir::getLen(argRef));
+        caller.placeInput(arg, tuple);
       } else {
         TODO(loc, "pass by value in non elemental function call");
       }
     }
 
     ExtValue result = genCallOpAndResult(caller, callSiteType, resultType);
 
-    // // Copy-out temps that were created for non contiguous variable arguments
-    // if
-    // // needed.
-    // for (const auto &copyOutPair : copyOutPairs)
-    //   genCopyOut(copyOutPair);
+    // Sync pointers and allocatables that may have been modified during the
+    // call.
+    for (const auto &mutableBox : mutableModifiedByCall)
+      fir::factory::syncMutableBoxFromIRBox(builder, loc, mutableBox);
+    // Handle case where result was passed as argument
+
+    // Copy-out temps that were created for non contiguous variable arguments if
+    // needed.
+    for (const auto &copyOutPair : copyOutPairs)
+      genCopyOut(copyOutPair);
 
     return result;
   }
 
   template <typename A>
   ExtValue genval(const Fortran::evaluate::FunctionRef<A> &funcRef) {
     ExtValue result = genFunctionRef(funcRef);
     if (result.rank() == 0 && fir::isa_ref_type(fir::getBase(result).getType()))
for (const auto &[arg, dummy] :
       llvm_unreachable("bad switch");
     }
     // Let the intrinsic library lower the intrinsic procedure call
     return Fortran::lower::genIntrinsicCall(builder, getLoc(), name, resultType,
                                             operands, stmtCtx);
   }
 
   template <typename A>
-  ExtValue genval(const Fortran::evaluate::Expr<A> &x) {
-    if (isScalar(x) || Fortran::evaluate::UnwrapWholeSymbolDataRef(x) ||
-        inInitializer)
-      return std::visit([&](const auto &e) { return genval(e); }, x.u);
-    return asArray(x);
+  bool isScalar(const A &x) {
+    return x.Rank() == 0;
   }
 
   /// Helper to detect Transformational function reference.
   template <typename T>
   bool isTransformationalRef(const T &) {
     return false;
   }
   template <typename T>
ExtValue gen(const Fortran::evaluate::Expr<A> &x) {
     if (isScalar(x) ||
         Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(x) ||
         isTransformationalRef(x))
       return std::visit([&](const auto &e) { return genref(e); }, x.u);
     if (useBoxArg)
       return asArrayArg(x);
     return asArray(x);
   }
-
   template <typename A>
-  bool isScalar(const A &x) {
-    return x.Rank() == 0;
+  ExtValue genval(const Fortran::evaluate::Expr<A> &x) {
+    if (isScalar(x) || Fortran::evaluate::UnwrapWholeSymbolDataRef(x) ||
+        inInitializer)
+      return std::visit([&](const auto &e) { return genval(e); }, x.u);
+    return asArray(x);
   }
 
   template <int KIND>
   ExtValue genval(const Fortran::evaluate::Expr<Fortran::evaluate::Type<
                       Fortran::common::TypeCategory::Logical, KIND>> &exp) {
     return std::visit([&](const auto &e) { return genval(e); }, exp.u);
   }
 
   using RefSet =
       std::tuple<Fortran::evaluate::ComplexPart, Fortran::evaluate::Substring,
                  Fortran::evaluate::DataRef, Fortran::evaluate::Component,
                  Fortran::evaluate::ArrayRef, Fortran::evaluate::CoarrayRef,
                  Fortran::semantics::SymbolRef>;
   template <typename A>
   static constexpr bool inRefSet = Fortran::common::HasMember<A, RefSet>;
 
   template <typename A, typename = std::enable_if_t<inRefSet<A>>>
   ExtValue genref(const A &a) {
     return gen(a);
   }
   template <typename A>
   ExtValue genref(const A &a) {
+    if (inInitializer) {
+      // Initialization expressions can never allocate memory.
+      return genval(a);
+    }
     mlir::Type storageType = converter.genType(toEvExpr(a));
     return placeScalarValueInMemory(builder, getLoc(), genval(a), storageType);
   }
 
   template <typename A, template <typename> typename T,
             typename B = std::decay_t<T<A>>,
             std::enable_if_t<
                 std::is_same_v<B, Fortran::evaluate::Expr<A>> ||
for (const auto &v : llvm::reverse(revPath)) {
                         ss.u);
                     ssIndex++;
                   }
                 }
                 ty = fir::unwrapSequenceType(ty);
               },
               [&](const Fortran::evaluate::Component *x) {
                 auto fieldTy = fir::FieldType::get(builder.getContext());
-                llvm::StringRef name = toStringRef(x->GetLastSymbol().name());
+                llvm::StringRef name = toStringRef(getLastSym(*x).name());
                 auto recTy = ty.cast<fir::RecordType>();
                 ty = recTy.getType(name);
                 auto fld = builder.create<fir::FieldIndexOp>(
                     loc, fieldTy, name, recTy, fir::getTypeParams(arrayExv));
                 addComponent(fld);
               }},
           v);
       atBase = false;
return [=](IterSpace iters) mutable {
       return lambda(newIters);
     };
   }
 
   template <typename A>
   CC genImplicitArrayAccess(const A &x, ComponentPath &components) {
     components.reversePath.push_back(ImplicitSubscripts{});
     ExtValue exv = asScalarRef(x);
-    // lowerPath(exv, components);
+    lowerPath(exv, components);
     auto lambda = genarr(exv, components);
     return [=](IterSpace iters) { return lambda(components.pc(iters)); };
   }
   CC genImplicitArrayAccess(const Fortran::evaluate::NamedEntity &x,
                             ComponentPath &components) {
     if (x.IsSymbol())
       return genImplicitArrayAccess(x.GetFirstSymbol(), components);
     return genImplicitArrayAccess(x.GetComponent(), components);

 private:
   void determineShapeOfDest(const fir::ExtendedValue &lhs) {
     destShape = fir::factory::getExtents(builder, getLoc(), lhs);
   }
 
   void determineShapeOfDest(const Fortran::lower::SomeExpr &lhs) {
     if (!destShape.empty())
       return;
-    // if (explicitSpaceIsActive() && determineShapeWithSlice(lhs))
-    //   return;
+    if (explicitSpaceIsActive() && determineShapeWithSlice(lhs))
+      return;
     mlir::Type idxTy = builder.getIndexType();
     mlir::Location loc = getLoc();
     if (std::optional<Fortran::evaluate::ConstantSubscripts> constantShape =
             Fortran::evaluate::GetConstantExtents(converter.getFoldingContext(),
                                                   lhs))
       for (Fortran::common::ConstantSubscript extent : *constantShape)
         destShape.push_back(builder.createIntegerConstant(loc, idxTy, extent));
   }
 
+  bool genShapeFromDataRef(const Fortran::semantics::Symbol &x) {
+    return false;
+  }
+  bool genShapeFromDataRef(const Fortran::evaluate::CoarrayRef &) {
+    TODO(getLoc(), "coarray ref");
+    return false;
+  }
+  bool genShapeFromDataRef(const Fortran::evaluate::Component &x) {
+    return x.base().Rank() > 0 ? genShapeFromDataRef(x.base()) : false;
+  }
+  bool genShapeFromDataRef(const Fortran::evaluate::ArrayRef &x) {
+    if (x.Rank() == 0)
+      return false;
+    if (x.base().Rank() > 0)
+      if (genShapeFromDataRef(x.base()))
+        return true;
+    // x has rank and x.base did not produce a shape.
+    ExtValue exv = x.base().IsSymbol() ? asScalarRef(getFirstSym(x.base()))
+                                       : asScalarRef(x.base().GetComponent());
+    mlir::Location loc = getLoc();
+    mlir::IndexType idxTy = builder.getIndexType();
+    llvm::SmallVector<mlir::Value> definedShape =
+        fir::factory::getExtents(builder, loc, exv);
+    mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+    for (auto ss : llvm::enumerate(x.subscript())) {
+      std::visit(Fortran::common::visitors{
+                     [&](const Fortran::evaluate::Triplet &trip) {
+                       // For a subscript of triple notation, we compute the
+                       // range of this dimension of the iteration space.
+                       auto lo = [&]() {
+                         if (auto optLo = trip.lower())
+                           return fir::getBase(asScalar(*optLo));
+                         return getLBound(exv, ss.index(), one);
+                       }();
+                       auto hi = [&]() {
+                         if (auto optHi = trip.upper())
+                           return fir::getBase(asScalar(*optHi));
+                         return getUBound(exv, ss.index(), one);
+                       }();
+                       auto step = builder.createConvert(
+                           loc, idxTy, fir::getBase(asScalar(trip.stride())));
+                       auto extent = builder.genExtentFromTriplet(loc, lo, hi,
+                                                                  step, idxTy);
+                       destShape.push_back(extent);
+                     },
+                     [&](auto) {}},
+                 ss.value().u);
+    }
+    return true;
+  }
+  bool genShapeFromDataRef(const Fortran::evaluate::NamedEntity &x) {
+    if (x.IsSymbol())
+      return genShapeFromDataRef(getFirstSym(x));
+    return genShapeFromDataRef(x.GetComponent());
+  }
+  bool genShapeFromDataRef(const Fortran::evaluate::DataRef &x) {
+    return std::visit([&](const auto &v) { return genShapeFromDataRef(v); },
+                      x.u);
+  }
+
+  /// When in an explicit space, the ranked component must be evaluated to
+  /// determine the actual number of iterations when slicing triples are
+  /// present. Lower these expressions here.
+  bool determineShapeWithSlice(const Fortran::lower::SomeExpr &lhs) {
+    LLVM_DEBUG(Fortran::lower::DumpEvaluateExpr::dump(
+        llvm::dbgs() << "determine shape of:\n", lhs));
+    // FIXME: We may not want to use ExtractDataRef here since it doesn't deal
+    // with substrings, etc.
+    std::optional<Fortran::evaluate::DataRef> dref =
+        Fortran::evaluate::ExtractDataRef(lhs);
+    return dref.has_value() ? genShapeFromDataRef(*dref) : false;
+  }
+
   ExtValue lowerArrayExpression(const Fortran::lower::SomeExpr &exp) {
     mlir::Type resTy = converter.genType(exp);
     return std::visit(
         [&](const auto &e) { return lowerArrayExpression(genarr(e), resTy); },
         exp.u);
   }
   ExtValue lowerArrayExpression(const ExtValue &exv) {
     assert(!explicitSpace);
auto lambda = ccStoreToDest.hasValue()
                       : defaultStoreToDestination(/*substring=*/nullptr);
     mlir::Value updVal = fir::getBase(lambda(iterSpace));
     finalizeElementCtx();
     builder.create<fir::ResultOp>(loc, updVal);
     builder.restoreInsertionPoint(insPt);
     return abstractArrayExtValue(iterSpace.outerResult());
   }
 
+  /// Compute the shape of a slice.
+  llvm::SmallVector<mlir::Value> computeSliceShape(mlir::Value slice) {
+    llvm::SmallVector<mlir::Value> slicedShape;
+    auto slOp = mlir::cast<fir::SliceOp>(slice.getDefiningOp());
+    mlir::Operation::operand_range triples = slOp.getTriples();
+    mlir::IndexType idxTy = builder.getIndexType();
+    mlir::Location loc = getLoc();
+    for (unsigned i = 0, end = triples.size(); i < end; i += 3) {
+      if (!mlir::isa_and_nonnull<fir::UndefOp>(
+              triples[i + 1].getDefiningOp())) {
+        // (..., lb:ub:step, ...) case:  extent = max((ub-lb+step)/step, 0)
+        // See Fortran 2018 9.5.3.3.2 section for more details.
+        mlir::Value res = builder.genExtentFromTriplet(
+            loc, triples[i], triples[i + 1], triples[i + 2], idxTy);
+        slicedShape.emplace_back(res);
+      } else {
+        // do nothing. `..., i, ...` case, so dimension is dropped.
+      }
+    }
+    return slicedShape;
+  }
+
   /// Get the shape from an ArrayOperand. The shape of the array is adjusted if
   /// the array was sliced.
   llvm::SmallVector<mlir::Value> getShape(ArrayOperand array) {
-    // if (array.slice)
-    //   return computeSliceShape(array.slice);
+    if (array.slice)
+      return computeSliceShape(array.slice);
     if (array.memref.getType().isa<fir::BoxType>())
       return fir::factory::readExtents(builder, getLoc(),
                                        fir::BoxValue{array.memref});
     std::vector<mlir::Value, std::allocator<mlir::Value>> extents =
         fir::factory::getExtents(array.shape);
     return {extents.begin(), extents.end()};
   }
 

flang/lib/Lower/ConvertVariable.cpp

 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/ConvertVariable.h"
 #include "flang/Lower/AbstractConverter.h"
 #include "flang/Lower/Allocatable.h"
 #include "flang/Lower/BoxAnalyzer.h"
 #include "flang/Lower/CallInterface.h"
 #include "flang/Lower/ConvertExpr.h"
+#include "flang/Lower/IntrinsicCall.h"
 #include "flang/Lower/Mangler.h"
 #include "flang/Lower/PFTBuilder.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/Support/Utils.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/Derived.h"
 #include "flang/Optimizer/Dialect/FIRAttr.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Dialect/FIROps.h"
 #include "flang/Optimizer/Support/FIRContext.h"
 #include "flang/Optimizer/Support/FatalError.h"
+#include "flang/Semantics/runtime-type-info.h"
 #include "flang/Semantics/tools.h"
 #include "llvm/Support/Debug.h"
 
 #define DEBUG_TYPE "flang-lower-variable"
 
-/// Helper to retrieve a copy of a character literal string from a SomeExpr.
-/// Required to build character global initializers.
-template <int KIND>
-static llvm::Optional<std::tuple<std::string, std::size_t>>
-getCharacterLiteralCopy(
-    const Fortran::evaluate::Expr<
-        Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>
-        &x) {
-  if (const auto *con =
-          Fortran::evaluate::UnwrapConstantValue<Fortran::evaluate::Type<
-              Fortran::common::TypeCategory::Character, KIND>>(x))
-    if (auto val = con->GetScalarValue())
-      return std::tuple<std::string, std::size_t>{
-          std::string{(const char *)val->c_str(),
-                      KIND * (std::size_t)con->LEN()},
-          (std::size_t)con->LEN()};
-  return llvm::None;
-}
-static llvm::Optional<std::tuple<std::string, std::size_t>>
-getCharacterLiteralCopy(
-    const Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter> &x) {
-  return std::visit([](const auto &e) { return getCharacterLiteralCopy(e); },
-                    x.u);
-}
-static llvm::Optional<std::tuple<std::string, std::size_t>>
-getCharacterLiteralCopy(const Fortran::lower::SomeExpr &x) {
-  if (const auto *e = Fortran::evaluate::UnwrapExpr<
-          Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter>>(x))
-    return getCharacterLiteralCopy(*e);
-  return llvm::None;
-}
-template <typename A>
-static llvm::Optional<std::tuple<std::string, std::size_t>>
-getCharacterLiteralCopy(const std::optional<A> &x) {
-  if (x)
-    return getCharacterLiteralCopy(*x);
-  return llvm::None;
-}
-
 /// Helper to lower a scalar expression using a specific symbol mapping.
 static mlir::Value genScalarValue(Fortran::lower::AbstractConverter &converter,
                                   mlir::Location loc,
                                   const Fortran::lower::SomeExpr &expr,
                                   Fortran::lower::SymMap &symMap,
                                   Fortran::lower::StatementContext &context) {
   // This does not use the AbstractConverter member function to override the
   // symbol mapping to be used expression lowering.

 }
 
 /// Can this symbol constant be placed in read-only memory?
 static bool isConstant(const Fortran::semantics::Symbol &sym) {
   return sym.attrs().test(Fortran::semantics::Attr::PARAMETER) ||
          sym.test(Fortran::semantics::Symbol::Flag::ReadOnly);
 }
 
+/// Is this a compiler generated symbol to describe derived types ?
+static bool isRuntimeTypeInfoData(const Fortran::semantics::Symbol &sym) {
+  // So far, use flags to detect if this symbol were generated during
+  // semantics::BuildRuntimeDerivedTypeTables(). Scope cannot be used since the
+  // symbols are injected in the user scopes defining the described derived
+  // types. A robustness improvement for this test could be to get hands on the
+  // semantics::RuntimeDerivedTypeTables and to check if the symbol names
+  // belongs to this structure.
+  return sym.test(Fortran::semantics::Symbol::Flag::CompilerCreated) &&
+         sym.test(Fortran::semantics::Symbol::Flag::ReadOnly);
+}
+
+static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
+                                  const Fortran::lower::pft::Variable &var,
+                                  llvm::StringRef globalName,
+                                  mlir::StringAttr linkage);
+
 /// Create the global op declaration without any initializer
 static fir::GlobalOp declareGlobal(Fortran::lower::AbstractConverter &converter,
                                    const Fortran::lower::pft::Variable &var,
                                    llvm::StringRef globalName,
                                    mlir::StringAttr linkage) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   if (fir::GlobalOp global = builder.getNamedGlobal(globalName))
     return global;
+  // Always define linkonce data since it may be optimized out from the module
+  // that actually owns the variable if it does not refers to it.
+  if (linkage == builder.createLinkOnceODRLinkage() ||
+      linkage == builder.createLinkOnceLinkage())
+    return defineGlobal(converter, var, globalName, linkage);
   const Fortran::semantics::Symbol &sym = var.getSymbol();
   mlir::Location loc = converter.genLocation(sym.name());
   // Resolve potential host and module association before checking that this
   // symbol is an object of a function pointer.
   const Fortran::semantics::Symbol &ultimate = sym.GetUltimate();
   if (!ultimate.has<Fortran::semantics::ObjectEntityDetails>() &&
       !ultimate.has<Fortran::semantics::ProcEntityDetails>())
     mlir::emitError(loc, "lowering global declaration: symbol '")
if (details && details->init()) {
             fir::factory::createUnallocatedBox(b, loc, symTy, llvm::None);
         b.create<fir::HasValueOp>(loc, box);
       });
     }
 
   } else if (const auto *details =
                  sym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
     if (details->init()) {
-      if (fir::isa_char(symTy)) {
-        // CHARACTER literal
-        if (auto chLit = getCharacterLiteralCopy(details->init().value())) {
-          mlir::StringAttr init =
-              builder.getStringAttr(std::get<std::string>(*chLit));
-          global->setAttr(global.getInitValAttrName(), init);
-        } else {
-          fir::emitFatalError(loc, "CHARACTER has unexpected initial value");
-        }
-      } else {
-        createGlobalInitialization(
-            builder, global, [&](fir::FirOpBuilder &builder) {
-              Fortran::lower::StatementContext stmtCtx(
-                  /*cleanupProhibited=*/true);
-              fir::ExtendedValue initVal = genInitializerExprValue(
-                  converter, loc, details->init().value(), stmtCtx);
-              mlir::Value castTo =
-                  builder.createConvert(loc, symTy, fir::getBase(initVal));
-              builder.create<fir::HasValueOp>(loc, castTo);
-            });
-      }
     } else if (hasDefaultInitialization(sym)) {
       createGlobalInitialization(
           builder, global, [&](fir::FirOpBuilder &builder) {
             Fortran::lower::StatementContext stmtCtx(
                 /*cleanupProhibited=*/true);
             mlir::Value initVal =
                 genDefaultInitializerValue(converter, loc, sym, symTy, stmtCtx);
             mlir::Value castTo = builder.createConvert(loc, symTy, initVal);
static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
   global.setVisibility(mlir::SymbolTable::Visibility::Public);
   return global;
 }
 
 /// Return linkage attribute for \p var.
 static mlir::StringAttr
 getLinkageAttribute(fir::FirOpBuilder &builder,
                     const Fortran::lower::pft::Variable &var) {
+  // Runtime type info for a same derived type is identical in each compilation
+  // unit. It desired to avoid having to link against module that only define a
+  // type. Therefore the runtime type info is generated everywhere it is needed
+  // with `linkonce_odr` LLVM linkage.
+  if (var.hasSymbol() && isRuntimeTypeInfoData(var.getSymbol()))
+    return builder.createLinkOnceODRLinkage();
   if (var.isModuleVariable())
     return {}; // external linkage
   // Otherwise, the variable is owned by a procedure and must not be visible in
   // other compilation units.
   return builder.createInternalLinkage();
 }
 
 /// Instantiate a global variable. If it hasn't already been processed, add
static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter,
   const Fortran::semantics::Symbol &ultimateSymbol =
       var.getSymbol().GetUltimate();
   llvm::StringRef symNm = toStringRef(ultimateSymbol.name());
   bool isTarg = var.isTarget();
   // Let the builder do all the heavy lifting.
   return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);
 }
 
+/// Must \p var be default initialized at runtime when entering its scope.
+static bool
+mustBeDefaultInitializedAtRuntime(const Fortran::lower::pft::Variable &var) {
+  if (!var.hasSymbol())
+    return false;
+  const Fortran::semantics::Symbol &sym = var.getSymbol();
+  if (var.isGlobal())
+    // Global variables are statically initialized.
+    return false;
+  if (Fortran::semantics::IsDummy(sym) && !Fortran::semantics::IsIntentOut(sym))
+    return false;
+  // Local variables (including function results), and intent(out) dummies must
+  // be default initialized at runtime if their type has default initialization.
+  return hasDefaultInitialization(sym);
+}
+
+/// Call default initialization runtime routine to initialize \p var.
+static void
+defaultInitializeAtRuntime(Fortran::lower::AbstractConverter &converter,
+                           const Fortran::lower::pft::Variable &var,
+                           Fortran::lower::SymMap &symMap) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::Location loc = converter.getCurrentLocation();
+  const Fortran::semantics::Symbol &sym = var.getSymbol();
+  fir::ExtendedValue exv = symMap.lookupSymbol(sym).toExtendedValue();
+  if (Fortran::semantics::IsOptional(sym)) {
+    // 15.5.2.12 point 3, absent optional dummies are not initialized.
+    // Creating descriptor/passing null descriptor to the runtime would
+    // create runtime crashes.
+    auto isPresent = builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
+                                                      fir::getBase(exv));
+    builder.genIfThen(loc, isPresent)
+        .genThen([&]() {
+          auto box = builder.createBox(loc, exv);
+          fir::runtime::genDerivedTypeInitialize(builder, loc, box);
+        })
+        .end();
+  } else {
+    mlir::Value box = builder.createBox(loc, exv);
+    fir::runtime::genDerivedTypeInitialize(builder, loc, box);
+  }
+}
+
 /// Instantiate a local variable. Precondition: Each variable will be visited
 /// such that if its properties depend on other variables, the variables upon
 /// which its properties depend will already have been visited.
 static void instantiateLocal(Fortran::lower::AbstractConverter &converter,
                              const Fortran::lower::pft::Variable &var,
                              Fortran::lower::SymMap &symMap) {
   assert(!var.isAlias());
   Fortran::lower::StatementContext stmtCtx;
   mapSymbolAttributes(converter, var, symMap, stmtCtx);
+  if (mustBeDefaultInitializedAtRuntime(var))
+    defaultInitializeAtRuntime(converter, var, symMap);
+}
+
+//===----------------------------------------------------------------===//
+// Aliased (EQUIVALENCE) variables instantiation
+//===----------------------------------------------------------------===//
+
+/// Insert \p aggregateStore instance into an AggregateStoreMap.
+static void insertAggregateStore(Fortran::lower::AggregateStoreMap &storeMap,
+                                 const Fortran::lower::pft::Variable &var,
+                                 mlir::Value aggregateStore) {
+  std::size_t off = var.getAggregateStore().getOffset();
+  Fortran::lower::AggregateStoreKey key = {var.getOwningScope(), off};
+  storeMap[key] = aggregateStore;
+}
+
+/// Retrieve the aggregate store instance of \p alias from an
+/// AggregateStoreMap.
+static mlir::Value
+getAggregateStore(Fortran::lower::AggregateStoreMap &storeMap,
+                  const Fortran::lower::pft::Variable &alias) {
+  Fortran::lower::AggregateStoreKey key = {alias.getOwningScope(),
+                                           alias.getAlias()};
+  auto iter = storeMap.find(key);
+  assert(iter != storeMap.end());
+  return iter->second;
+}
+
+/// Build the name for the storage of a global equivalence.
+static std::string mangleGlobalAggregateStore(
+    const Fortran::lower::pft::Variable::AggregateStore &st) {
+  return Fortran::lower::mangle::mangleName(st.getNamingSymbol());
+}
+
+/// Build the type for the storage of an equivalence.
+static mlir::Type
+getAggregateType(Fortran::lower::AbstractConverter &converter,
+                 const Fortran::lower::pft::Variable::AggregateStore &st) {
+  if (const Fortran::semantics::Symbol *initSym = st.getInitialValueSymbol())
+    return converter.genType(*initSym);
+  mlir::IntegerType byteTy = converter.getFirOpBuilder().getIntegerType(8);
+  return fir::SequenceType::get(std::get<1>(st.interval), byteTy);
+}
+
+/// Define a GlobalOp for the storage of a global equivalence described
+/// by \p aggregate. The global is named \p aggName and is created with
+/// the provided \p linkage.
+/// If any of the equivalence members are initialized, an initializer is
+/// created for the equivalence.
+/// This is to be used when lowering the scope that owns the equivalence
+/// (as opposed to simply using it through host or use association).
+/// This is not to be used for equivalence of common block members (they
+/// already have the common block GlobalOp for them, see defineCommonBlock).
+static fir::GlobalOp defineGlobalAggregateStore(
+    Fortran::lower::AbstractConverter &converter,
+    const Fortran::lower::pft::Variable::AggregateStore &aggregate,
+    llvm::StringRef aggName, mlir::StringAttr linkage) {
+  assert(aggregate.isGlobal() && "not a global interval");
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  fir::GlobalOp global = builder.getNamedGlobal(aggName);
+  if (global && globalIsInitialized(global))
+    return global;
+  mlir::Location loc = converter.getCurrentLocation();
+  mlir::Type aggTy = getAggregateType(converter, aggregate);
+  if (!global)
+    global = builder.createGlobal(loc, aggTy, aggName, linkage);
+
+  if (const Fortran::semantics::Symbol *initSym =
+          aggregate.getInitialValueSymbol())
+    if (const auto *objectDetails =
+            initSym->detailsIf<Fortran::semantics::ObjectEntityDetails>())
+      if (objectDetails->init()) {
+        createGlobalInitialization(
+            builder, global, [&](fir::FirOpBuilder &builder) {
+              Fortran::lower::StatementContext stmtCtx;
+              mlir::Value initVal = fir::getBase(genInitializerExprValue(
+                  converter, loc, objectDetails->init().value(), stmtCtx));
+              builder.create<fir::HasValueOp>(loc, initVal);
+            });
+        return global;
+      }
+  // Equivalence has no Fortran initial value. Create an undefined FIR initial
+  // value to ensure this is consider an object definition in the IR regardless
+  // of the linkage.
+  createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &builder) {
+    Fortran::lower::StatementContext stmtCtx;
+    mlir::Value initVal = builder.create<fir::UndefOp>(loc, aggTy);
+    builder.create<fir::HasValueOp>(loc, initVal);
+  });
+  return global;
+}
+
+/// Declare a GlobalOp for the storage of a global equivalence described
+/// by \p aggregate. The global is named \p aggName and is created with
+/// the provided \p linkage.
+/// No initializer is built for the created GlobalOp.
+/// This is to be used when lowering the scope that uses members of an
+/// equivalence it through host or use association.
+/// This is not to be used for equivalence of common block members (they
+/// already have the common block GlobalOp for them, see defineCommonBlock).
+static fir::GlobalOp declareGlobalAggregateStore(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    const Fortran::lower::pft::Variable::AggregateStore &aggregate,
+    llvm::StringRef aggName, mlir::StringAttr linkage) {
+  assert(aggregate.isGlobal() && "not a global interval");
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  if (fir::GlobalOp global = builder.getNamedGlobal(aggName))
+    return global;
+  mlir::Type aggTy = getAggregateType(converter, aggregate);
+  return builder.createGlobal(loc, aggTy, aggName, linkage);
+}
+
+/// This is an aggregate store for a set of EQUIVALENCED variables. Create the
+/// storage on the stack or global memory and add it to the map.
+static void
+instantiateAggregateStore(Fortran::lower::AbstractConverter &converter,
+                          const Fortran::lower::pft::Variable &var,
+                          Fortran::lower::AggregateStoreMap &storeMap) {
+  assert(var.isAggregateStore() && "not an interval");
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::IntegerType i8Ty = builder.getIntegerType(8);
+  mlir::Location loc = converter.getCurrentLocation();
+  std::string aggName = mangleGlobalAggregateStore(var.getAggregateStore());
+  if (var.isGlobal()) {
+    fir::GlobalOp global;
+    auto &aggregate = var.getAggregateStore();
+    mlir::StringAttr linkage = getLinkageAttribute(builder, var);
+    if (var.isModuleVariable()) {
+      // A module global was or will be defined when lowering the module. Emit
+      // only a declaration if the global does not exist at that point.
+      global = declareGlobalAggregateStore(converter, loc, aggregate, aggName,
+                                           linkage);
+    } else {
+      global =
+          defineGlobalAggregateStore(converter, aggregate, aggName, linkage);
+    }
+    auto addr = builder.create<fir::AddrOfOp>(loc, global.resultType(),
+                                              global.getSymbol());
+    auto size = std::get<1>(var.getInterval());
+    fir::SequenceType::Shape shape(1, size);
+    auto seqTy = fir::SequenceType::get(shape, i8Ty);
+    mlir::Type refTy = builder.getRefType(seqTy);
+    mlir::Value aggregateStore = builder.createConvert(loc, refTy, addr);
+    insertAggregateStore(storeMap, var, aggregateStore);
+    return;
+  }
+  // This is a local aggregate, allocate an anonymous block of memory.
+  auto size = std::get<1>(var.getInterval());
+  fir::SequenceType::Shape shape(1, size);
+  auto seqTy = fir::SequenceType::get(shape, i8Ty);
+  mlir::Value local =
+      builder.allocateLocal(loc, seqTy, aggName, "", llvm::None, llvm::None,
+                            /*target=*/false);
+  insertAggregateStore(storeMap, var, local);
 }
 
 /// Cast an alias address (variable part of an equivalence) to fir.ptr so that
 /// the optimizer is conservative and avoids doing copy elision in assignment
 /// involving equivalenced variables.
 /// TODO: Represent the equivalence aliasing constraint in another way to avoid
 /// pessimizing array assignments involving equivalenced variables.
 static mlir::Value castAliasToPointer(fir::FirOpBuilder &builder,
                                       mlir::Location loc, mlir::Type aliasType,
                                       mlir::Value aliasAddr) {
   return builder.createConvert(loc, fir::PointerType::get(aliasType),
                                aliasAddr);
 }
 
+/// Instantiate a member of an equivalence. Compute its address in its
+/// aggregate storage and lower its attributes.
+static void instantiateAlias(Fortran::lower::AbstractConverter &converter,
+                             const Fortran::lower::pft::Variable &var,
+                             Fortran::lower::SymMap &symMap,
+                             Fortran::lower::AggregateStoreMap &storeMap) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  assert(var.isAlias());
+  const Fortran::semantics::Symbol &sym = var.getSymbol();
+  const mlir::Location loc = converter.genLocation(sym.name());
+  mlir::IndexType idxTy = builder.getIndexType();
+  std::size_t aliasOffset = var.getAlias();
+  mlir::Value store = getAggregateStore(storeMap, var);
+  mlir::IntegerType i8Ty = builder.getIntegerType(8);
+  mlir::Type i8Ptr = builder.getRefType(i8Ty);
+  mlir::Value offset = builder.createIntegerConstant(
+      loc, idxTy, sym.GetUltimate().offset() - aliasOffset);
+  auto ptr = builder.create<fir::CoordinateOp>(loc, i8Ptr, store,
+                                               mlir::ValueRange{offset});
+  mlir::Value preAlloc =
+      castAliasToPointer(builder, loc, converter.genType(sym), ptr);
+  Fortran::lower::StatementContext stmtCtx;
+  mapSymbolAttributes(converter, var, symMap, stmtCtx, preAlloc);
+  // Default initialization is possible for equivalence members: see
+  // F2018 19.5.3.4. Note that if several equivalenced entities have
+  // default initialization, they must have the same type, and the standard
+  // allows the storage to be default initialized several times (this has
+  // no consequences other than wasting some execution time). For now,
+  // do not try optimizing this to single default initializations of
+  // the equivalenced storages. Keep lowering simple.
+  if (mustBeDefaultInitializedAtRuntime(var))
+    defaultInitializeAtRuntime(converter, var, symMap);
+}
+
 //===--------------------------------------------------------------===//
 // COMMON blocks instantiation
 //===--------------------------------------------------------------===//
 
 /// Does any member of the common block has an initializer ?
 static bool
 commonBlockHasInit(const Fortran::semantics::MutableSymbolVector &cmnBlkMems) {
   for (const Fortran::semantics::MutableSymbolRef &mem : cmnBlkMems) {
ba.match(
         mlir::Value local =
             createNewLocal(converter, loc, var, preAlloc, llvm::None, lengths);
         symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
       },
 
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::details::DynamicArrayStaticChar &x) {
-        TODO(loc, "DynamicArrayStaticChar variable lowering");
+        mlir::Value addr;
+        mlir::Value len;
+        mlir::Value argBox;
+        auto charLen = x.charLen();
+        // if element type is a CHARACTER, determine the LEN value
+        if (isDummy) {
+          mlir::Value actualArg = symMap.lookupSymbol(sym).getAddr();
+          if (auto boxTy = actualArg.getType().dyn_cast<fir::BoxType>()) {
+            argBox = actualArg;
+            mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
+            addr = builder.create<fir::BoxAddrOp>(loc, refTy, argBox);
+          } else {
+            addr = charHelp.createUnboxChar(actualArg).first;
+          }
+          // Set/override LEN with a constant
+          len = builder.createIntegerConstant(loc, idxTy, charLen);
+        } else {
+          // local CHARACTER variable
+          len = builder.createIntegerConstant(loc, idxTy, charLen);
+        }
+
+        // cast to the known constant parts from the declaration
+        mlir::Type castTy = builder.getRefType(converter.genType(var));
+        if (addr)
+          addr = builder.createConvert(loc, castTy, addr);
+        if (x.lboundAllOnes()) {
+          // if lower bounds are all ones, build simple shaped object
+          llvm::SmallVector<mlir::Value> shape;
+          populateShape(shape, x.bounds, argBox);
+          if (isDummy) {
+            symMap.addCharSymbolWithShape(sym, addr, len, shape, true);
+            return;
+          }
+          // local CHARACTER array
+          mlir::Value local =
+              createNewLocal(converter, loc, var, preAlloc, shape);
+          symMap.addCharSymbolWithShape(sym, local, len, shape);
+          return;
+        }
+        // if object is an array process the lower bound and extent values
+        llvm::SmallVector<mlir::Value> extents;
+        llvm::SmallVector<mlir::Value> lbounds;
+        populateLBoundsExtents(lbounds, extents, x.bounds, argBox);
+        if (isDummy) {
+          symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
+                                         true);
+          return;
+        }
+        // local CHARACTER array with computed bounds
+        assert(Fortran::lower::isExplicitShape(sym));
+        mlir::Value local =
+            createNewLocal(converter, loc, var, preAlloc, extents);
+        symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
       },
 
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::details::DynamicArrayDynamicChar &x) {
-        TODO(loc, "DynamicArrayDynamicChar variable lowering");
+        mlir::Value addr;
+        mlir::Value len;
+        mlir::Value argBox;
+        auto charLen = x.charLen();
+        // if element type is a CHARACTER, determine the LEN value
+        if (isDummy) {
+          mlir::Value actualArg = symMap.lookupSymbol(sym).getAddr();
+          if (auto boxTy = actualArg.getType().dyn_cast<fir::BoxType>()) {
+            argBox = actualArg;
+            mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
+            addr = builder.create<fir::BoxAddrOp>(loc, refTy, argBox);
+            if (charLen)
+              // Set/override LEN with an expression.
+              len = genExplicitCharLen(charLen);
+            else
+              // Get the length from the actual arguments.
+              len = charHelp.readLengthFromBox(argBox);
+          } else {
+            std::pair<mlir::Value, mlir::Value> unboxchar =
+                charHelp.createUnboxChar(actualArg);
+            addr = unboxchar.first;
+            if (charLen) {
+              // Set/override LEN with an expression
+              len = genExplicitCharLen(charLen);
+            } else {
+              // Get the length from the actual arguments.
+              len = unboxchar.second;
+            }
+          }
+        } else {
+          // local CHARACTER variable
+          len = genExplicitCharLen(charLen);
+        }
+        llvm::SmallVector<mlir::Value> lengths = {len};
+
+        // cast to the known constant parts from the declaration
+        mlir::Type castTy = builder.getRefType(converter.genType(var));
+        if (addr)
+          addr = builder.createConvert(loc, castTy, addr);
+        if (x.lboundAllOnes()) {
+          // if lower bounds are all ones, build simple shaped object
+          llvm::SmallVector<mlir::Value> shape;
+          populateShape(shape, x.bounds, argBox);
+          if (isDummy) {
+            symMap.addCharSymbolWithShape(sym, addr, len, shape, true);
+            return;
+          }
+          // local CHARACTER array
+          mlir::Value local =
+              createNewLocal(converter, loc, var, preAlloc, shape, lengths);
+          symMap.addCharSymbolWithShape(sym, local, len, shape);
+          return;
+        }
+        // Process the lower bound and extent values.
+        llvm::SmallVector<mlir::Value> extents;
+        llvm::SmallVector<mlir::Value> lbounds;
+        populateLBoundsExtents(lbounds, extents, x.bounds, argBox);
+        if (isDummy) {
+          symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
+                                         true);
+          return;
+        }
+        // local CHARACTER array with computed bounds
+        assert(Fortran::lower::isExplicitShape(sym));
+        mlir::Value local =
+            createNewLocal(converter, loc, var, preAlloc, extents, lengths);
+        symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
       },
 
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::BoxAnalyzer::None &) {
         mlir::emitError(loc, "symbol analysis failed on ")
             << toStringRef(sym.name());
       });
 }
 
 void Fortran::lower::defineModuleVariable(
     AbstractConverter &converter, const Fortran::lower::pft::Variable &var) {
   // Use empty linkage for module variables, which makes them available
   // for use in another unit.
-  mlir::StringAttr externalLinkage;
+  mlir::StringAttr linkage =
+      getLinkageAttribute(converter.getFirOpBuilder(), var);
   if (!var.isGlobal())
     fir::emitFatalError(converter.getCurrentLocation(),
                         "attempting to lower module variable as local");
   // Define aggregate storages for equivalenced objects.
   if (var.isAggregateStore()) {
-    const mlir::Location loc = converter.genLocation(var.getSymbol().name());
-    TODO(loc, "defineModuleVariable aggregateStore");
+    const Fortran::lower::pft::Variable::AggregateStore &aggregate =
+        var.getAggregateStore();
+    std::string aggName = mangleGlobalAggregateStore(aggregate);
+    defineGlobalAggregateStore(converter, aggregate, aggName, linkage);
+    return;
   }
   const Fortran::semantics::Symbol &sym = var.getSymbol();
   if (const Fortran::semantics::Symbol *common =
           Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) {
     // Define common block containing the variable.
     defineCommonBlock(converter, *common);
   } else if (var.isAlias()) {
     // Do nothing. Mapping will be done on user side.
   } else {
     std::string globalName = Fortran::lower::mangle::mangleName(sym);
-    defineGlobal(converter, var, globalName, externalLinkage);
+    defineGlobal(converter, var, globalName, linkage);
   }
 }
 
 void Fortran::lower::instantiateVariable(AbstractConverter &converter,
                                          const pft::Variable &var,
-                                         SymMap &symMap,
+                                         Fortran::lower::SymMap &symMap,
                                          AggregateStoreMap &storeMap) {
-  const Fortran::semantics::Symbol &sym = var.getSymbol();
-  const mlir::Location loc = converter.genLocation(sym.name());
   if (var.isAggregateStore()) {
-    TODO(loc, "instantiateVariable AggregateStore");
+    instantiateAggregateStore(converter, var, storeMap);
   } else if (const Fortran::semantics::Symbol *common =
                  Fortran::semantics::FindCommonBlockContaining(
                      var.getSymbol().GetUltimate())) {
     instantiateCommon(converter, *common, var, symMap);
   } else if (var.isAlias()) {
-    TODO(loc, "instantiateVariable Alias");
+    instantiateAlias(converter, var, symMap, storeMap);
   } else if (var.isGlobal()) {
     instantiateGlobal(converter, var, symMap);
   } else {
     instantiateLocal(converter, var, symMap);
   }
 }
 
 void Fortran::lower::mapCallInterfaceSymbols(
if (var.isAggregateStore()) {
       // If this is neither a host associated or dummy symbol, it must be a
       // module or common block variable to satisfy specification expression
       // requirements in 10.1.11, instantiateVariable will get its address and
       // properties.
       instantiateVariable(converter, var, symMap, storeMap);
     }
   }
 }
+
+void Fortran::lower::createRuntimeTypeInfoGlobal(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    const Fortran::semantics::Symbol &typeInfoSym) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  std::string globalName = Fortran::lower::mangle::mangleName(typeInfoSym);
+  auto var = Fortran::lower::pft::Variable(typeInfoSym, /*global=*/true);
+  mlir::StringAttr linkage = getLinkageAttribute(builder, var);
+  defineGlobal(converter, var, globalName, linkage);
+}

flang/lib/Lower/IntrinsicCall.cpp

 /// Test if an ExtendedValue is absent.
 static bool isAbsent(const fir::ExtendedValue &exv) {
   return !fir::getBase(exv);
 }
 static bool isAbsent(llvm::ArrayRef<fir::ExtendedValue> args, size_t argIndex) {
   return args.size() <= argIndex || isAbsent(args[argIndex]);
 }
 
+/// Test if an ExtendedValue is present.
+static bool isPresent(const fir::ExtendedValue &exv) { return !isAbsent(exv); }
+
 /// Process calls to Maxval, Minval, Product, Sum intrinsic functions that
 /// take a DIM argument.
 template <typename FD>
 static fir::ExtendedValue
 genFuncDim(FD funcDim, mlir::Type resultType, fir::FirOpBuilder &builder,
            mlir::Location loc, Fortran::lower::StatementContext *stmtCtx,
            llvm::StringRef errMsg, mlir::Value array, fir::ExtendedValue dimArg,
            mlir::Value mask, int rank) {
fir::ExtendedValue genDotProduct(mlir::Type,
                                    llvm::ArrayRef<fir::ExtendedValue>);
   template <Extremum, ExtremumBehavior>
   mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
   /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
   /// in the llvm::ArrayRef.
   mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIbits(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 
   /// Define the different FIR generators that can be mapped to intrinsic to
   /// generate the related code.
   using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
   using ExtendedGenerator = decltype(&IntrinsicLibrary::genSum);
static constexpr IntrinsicHandler handlers[]{
     {"dim", &I::genDim},
     {"dot_product",
      &I::genDotProduct,
      {{{"vector_a", asBox}, {"vector_b", asBox}}},
      /*isElemental=*/false},
     {"iand", &I::genIand},
     {"ibits", &I::genIbits},
     {"min", &I::genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>},
+    {"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false},
     {"sum",
      &I::genSum,
      {{{"array", asBox},
        {"dim", asValue},
        {"mask", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"ubound",
      &I::genUbound,
mlir::Value IntrinsicLibrary::genExtremum(mlir::Type,
   for (auto arg : args.drop_front()) {
     mlir::Value mask =
         createExtremumCompare<extremum, behavior>(loc, builder, result, arg);
     result = builder.create<mlir::arith::SelectOp>(loc, mask, result, arg);
   }
   return result;
 }
 
+// NULL
+fir::ExtendedValue
+IntrinsicLibrary::genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue> args) {
+  // NULL() without MOLD must be handled in the contexts where it can appear
+  // (see table 16.5 of Fortran 2018 standard).
+  assert(args.size() == 1 && isPresent(args[0]) &&
+         "MOLD argument required to lower NULL outside of any context");
+  const auto *mold = args[0].getBoxOf<fir::MutableBoxValue>();
+  assert(mold && "MOLD must be a pointer or allocatable");
+  fir::BoxType boxType = mold->getBoxTy();
+  mlir::Value boxStorage = builder.createTemporary(loc, boxType);
+  mlir::Value box = fir::factory::createUnallocatedBox(
+      builder, loc, boxType, mold->nonDeferredLenParams());
+  builder.create<fir::StoreOp>(loc, box, boxStorage);
+  return fir::MutableBoxValue(boxStorage, mold->nonDeferredLenParams(), {});
+}
+
 // SUM
 fir::ExtendedValue
 IntrinsicLibrary::genSum(mlir::Type resultType,
                          llvm::ArrayRef<fir::ExtendedValue> args) {
   return genProdOrSum(fir::runtime::genSum, fir::runtime::genSumDim, resultType,
                       builder, loc, stmtCtx, "unexpected result for Sum", args);
 }
 

flang/lib/Lower/SymbolMap.cpp

exv.match([&](const fir::UnboxedValue &v) { addSymbol(sym, v, force); },
             [&](const fir::BoxValue &v) { makeSym(sym, v, force); },
             [&](const fir::MutableBoxValue &v) { makeSym(sym, v, force); },
             [](auto) {
               llvm::report_fatal_error("value not added to symbol table");
             });
 }
 
 Fortran::lower::SymbolBox
-Fortran::lower::SymMap::lookupSymbol(Fortran::semantics::SymbolRef sym) {
+Fortran::lower::SymMap::lookupSymbol(Fortran::semantics::SymbolRef symRef) {
+  Fortran::semantics::SymbolRef sym = symRef.get().GetUltimate();
   for (auto jmap = symbolMapStack.rbegin(), jend = symbolMapStack.rend();
        jmap != jend; ++jmap) {
     auto iter = jmap->find(&*sym);
     if (iter != jmap->end())
       return iter->second;
   }
   return SymbolBox::None{};
 }
 
+Fortran::lower::SymbolBox Fortran::lower::SymMap::shallowLookupSymbol(
+    Fortran::semantics::SymbolRef symRef) {
+  auto &map = symbolMapStack.back();
+  auto iter = map.find(&symRef.get().GetUltimate());
+  if (iter != map.end())
+    return iter->second;
+  return SymbolBox::None{};
+}
+
 mlir::Value
 Fortran::lower::SymMap::lookupImpliedDo(Fortran::lower::SymMap::AcDoVar var) {
   for (auto [marker, binding] : llvm::reverse(impliedDoStack))
     if (var == marker)
       return binding;
   return {};
 }
 

flang/test/Lower/nullify.f90

+! Test lowering of nullify-statement
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+
+! -----------------------------------------------------------------------------
+!     Test NULLIFY(p)
+! -----------------------------------------------------------------------------
+
+
+! CHECK-LABEL: func @_QPtest_scalar(
+! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}})
+subroutine test_scalar(p)
+    real, pointer :: p
+    ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<f32>
+    ! CHECK: %[[box:.*]] = fir.embox %[[null]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+    nullify(p)
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPtest_scalar_char(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>{{.*}})
+  subroutine test_scalar_char(p)
+    character(:), pointer :: p
+    ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<!fir.char<1,?>>
+    ! CHECK: %[[box:.*]] = fir.embox %[[null]] typeparams %c0{{.*}} : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+    nullify(p)
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPtest_array(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}})
+  subroutine test_array(p)
+    real, pointer :: p(:)
+    ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+    ! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}}
+    ! CHECK: %[[box:.*]] = fir.embox %[[null]](%[[shape]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    nullify(p)
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPtest_list(
+  ! CHECK-SAME: %[[p1:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}}, %[[p2:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}})
+  subroutine test_list(p1, p2)
+    real, pointer :: p1, p2(:)
+    ! CHECK: fir.zero_bits !fir.ptr<f32>
+    ! CHECK: fir.store %{{.*}} to %[[p1]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+  
+    ! CHECK: fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+    ! CHECK: fir.store %{{.*}} to %[[p2]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    nullify(p1, p2)
+  end subroutine

flang/test/Lower/pointer-assignments.f90

+! Test lowering of pointer assignments
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+
+! Note that p => NULL() are tested in pointer-disassociate.f90
+
+! -----------------------------------------------------------------------------
+!     Test simple pointer assignments to contiguous right-hand side
+! -----------------------------------------------------------------------------
+
+! CHECK-LABEL: func @_QPtest_scalar(
+! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}}, %[[x:.*]]: !fir.ref<f32> {{{.*}}, fir.target})
+subroutine test_scalar(p, x)
+    real, target :: x
+    real, pointer :: p
+    ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<f32>) -> !fir.box<!fir.ptr<f32>>
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+    p => x
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPtest_scalar_char(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target})
+  subroutine test_scalar_char(p, x)
+    character(*), target :: x
+    character(:), pointer :: p
+    ! CHECK: %[[c:.*]]:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+    ! CHECK: %[[box:.*]] = fir.embox %[[c]]#0 typeparams %[[c]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+    p => x
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPtest_array(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[x:.*]]: !fir.ref<!fir.array<100xf32>> {{{.*}}, fir.target})
+  subroutine test_array(p, x)
+    real, target :: x(100)
+    real, pointer :: p(:)
+    ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}}
+    ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    p => x
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPtest_array_char(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target}) {
+  subroutine test_array_char(p, x)
+    character(*), target :: x(100)
+    character(:), pointer :: p(:)
+    ! CHECK: %[[c:.*]]:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+    ! CHECK: %[[xaddr:.*]] = fir.convert %[[c]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<100x!fir.char<1,?>>>
+    ! CHECK-DAG: %[[xaddr2:.*]] = fir.convert %[[xaddr]] : (!fir.ref<!fir.array<100x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
+    ! CHECK-DAG: %[[shape:.*]] = fir.shape %c100{{.*}}
+    ! CHECK: %[[box:.*]] = fir.embox %[[xaddr2]](%[[shape]]) typeparams %[[c]]#1
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
+    p => x
+  end subroutine
+  
+  ! Test 10.2.2.3 point 10: lower bounds requirements:
+  ! pointer takes lbounds from rhs if no bounds spec.
+  ! CHECK-LABEL: func @_QPtest_array_with_lbs(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+  subroutine test_array_with_lbs(p, x)
+    real, target :: x(51:150)
+    real, pointer :: p(:)
+    ! CHECK: %[[shape:.*]] = fir.shape_shift %c51{{.*}}, %c100{{.*}}
+    ! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    p => x
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !    Test pointer assignments with bound specs to contiguous right-hand side
+  ! -----------------------------------------------------------------------------
+  
+  ! Test 10.2.2.3 point 10: lower bounds requirements:
+  ! pointer takes lbounds from bound spec if specified
+  ! CHECK-LABEL: func @_QPtest_array_with_new_lbs(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+  subroutine test_array_with_new_lbs(p, x)
+    real, target :: x(51:150)
+    real, pointer :: p(:)
+    ! CHECK: %[[shape:.*]] = fir.shape_shift %c4{{.*}}, %c100{{.*}}
+    ! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    p(4:) => x
+  end subroutine
+  
+  ! Test F2018 10.2.2.3 point 9: bounds remapping
+  ! CHECK-LABEL: func @_QPtest_array_remap(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>{{.*}}, %[[x:.*]]: !fir.ref<!fir.array<100xf32>> {{{.*}}, fir.target})
+  subroutine test_array_remap(p, x)
+    real, target :: x(100)
+    real, pointer :: p(:, :)
+    ! CHECK-DAG: %[[c2_idx:.*]] = fir.convert %c2{{.*}} : (i64) -> index
+    ! CHECK-DAG: %[[c11_idx:.*]] = fir.convert %c11{{.*}} : (i64) -> index
+    ! CHECK-DAG: %[[diff0:.*]] = arith.subi %[[c11_idx]], %[[c2_idx]] : index
+    ! CHECK-DAG: %[[ext0:.*]] = arith.addi %[[diff0:.*]], %c1{{.*}} : index
+    ! CHECK-DAG: %[[c3_idx:.*]] = fir.convert %c3{{.*}} : (i64) -> index
+    ! CHECK-DAG: %[[c12_idx:.*]] = fir.convert %c12{{.*}} : (i64) -> index
+    ! CHECK-DAG: %[[diff1:.*]] = arith.subi %[[c12_idx]], %[[c3_idx]] : index
+    ! CHECK-DAG: %[[ext1:.*]] = arith.addi %[[diff1]], %c1{{.*}} : index
+    ! CHECK-DAG: %[[addrCast:.*]] = fir.convert %[[x]] : (!fir.ref<!fir.array<100xf32>>) -> !fir.ref<!fir.array<?x?xf32>>
+    ! CHECK: %[[shape:.*]] = fir.shape_shift %c2{{.*}}, %[[ext0]], %c3{{.*}}, %[[ext1]]
+    ! CHECK: %[[box:.*]] = fir.embox %[[addrCast]](%[[shape]]) : (!fir.ref<!fir.array<?x?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+    p(2:11, 3:12) => x
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPtest_array_char_remap(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target})
+  subroutine test_array_char_remap(p, x)
+    ! CHECK: %[[unbox:.*]]:2 = fir.unboxchar %[[x]]
+    character(*), target :: x(100)
+    character(:), pointer :: p(:, :)
+    ! CHECK: subi
+    ! CHECK: %[[ext0:.*]] = arith.addi
+    ! CHECK: subi
+    ! CHECK: %[[ext1:.*]] = arith.addi
+    ! CHECK: %[[shape:.*]] = fir.shape_shift %c2{{.*}}, %[[ext0]], %c3{{.*}}, %[[ext1]]
+    ! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) typeparams %[[unbox]]#1 : (!fir.ref<!fir.array<?x?x!fir.char<1,?>>>, !fir.shapeshift<2>, index) -> !fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>
+    ! CHECK: fir.store %[[box]] to %[[p]]
+    p(2:11, 3:12) => x
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !  Test simple pointer assignments to non contiguous right-hand side
+  ! -----------------------------------------------------------------------------
+  
+  ! CHECK-LABEL: func @_QPtest_array_non_contig_rhs(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[x:.*]]: !fir.box<!fir.array<?xf32>> {{{.*}}, fir.target})
+  subroutine test_array_non_contig_rhs(p, x)
+    real, target :: x(:)
+    real, pointer :: p(:)
+    ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    p => x
+  end subroutine
+  
+  ! Test 10.2.2.3 point 10: lower bounds requirements:
+  ! pointer takes lbounds from rhs if no bounds spec.
+  ! CHECK-LABEL: func @_QPtest_array_non_contig_rhs_lbs(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[x:.*]]: !fir.box<!fir.array<?xf32>> {{{.*}}, fir.target})
+  subroutine test_array_non_contig_rhs_lbs(p, x)
+    real, target :: x(7:)
+    real, pointer :: p(:)
+    ! CHECK: %[[c7_idx:.*]] = fir.convert %c7{{.*}} : (i64) -> index
+    ! CHECK: %[[shift:.*]] = fir.shift %[[c7_idx]] : (index) -> !fir.shift<1>
+    ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shift]]) : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+  
+    ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    p => x
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPtest_array_non_contig_rhs2(
+  ! CHECK-SAME:                                      %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[VAL_1:.*]]: !fir.ref<!fir.array<200xf32>> {{{.*}}, fir.target}) {
+  ! CHECK:         %[[VAL_2:.*]] = arith.constant 200 : index
+  ! CHECK:         %[[VAL_3:.*]] = arith.constant 10 : i64
+  ! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
+  ! CHECK:         %[[VAL_5:.*]] = arith.constant 3 : i64
+  ! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> index
+  ! CHECK:         %[[VAL_7:.*]] = arith.constant 160 : i64
+  ! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
+  ! CHECK:         %[[VAL_9:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
+  ! CHECK:         %[[VAL_10:.*]] = fir.slice %[[VAL_4]], %[[VAL_8]], %[[VAL_6]] : (index, index, index) -> !fir.slice<1>
+  ! CHECK:         %[[VAL_11:.*]] = fir.embox %[[VAL_1]](%[[VAL_9]]) {{\[}}%[[VAL_10]]] : (!fir.ref<!fir.array<200xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_12:.*]] = fir.rebox %[[VAL_11]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+  ! CHECK:         fir.store %[[VAL_12]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+  ! CHECK:         return
+  ! CHECK:       }
+  
+  subroutine test_array_non_contig_rhs2(p, x)
+    real, target :: x(200)
+    real, pointer :: p(:)
+    p => x(10:160:3)
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !  Test pointer assignments with bound specs to non contiguous right-hand side
+  ! -----------------------------------------------------------------------------
+  
+  
+  ! Test 10.2.2.3 point 10: lower bounds requirements:
+  ! pointer takes lbounds from bound spec if specified
+  ! CHECK-LABEL: func @_QPtest_array_non_contig_rhs_new_lbs(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[x:.*]]: !fir.box<!fir.array<?xf32>> {{{.*}}, fir.target})
+  subroutine test_array_non_contig_rhs_new_lbs(p, x)
+    real, target :: x(7:)
+    real, pointer :: p(:)
+    ! CHECK: %[[shift:.*]] = fir.shift %c4{{.*}}
+    ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shift]]) : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+  
+    ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    p(4:) => x
+  end subroutine
+  
+  ! Test F2018 10.2.2.3 point 9: bounds remapping
+  ! CHECK-LABEL: func @_QPtest_array_non_contig_remap(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>{{.*}}, %[[x:.*]]: !fir.box<!fir.array<?xf32>> {{{.*}}, fir.target})
+  subroutine test_array_non_contig_remap(p, x)
+    real, target :: x(:)
+    real, pointer :: p(:, :)
+    ! CHECK: subi
+    ! CHECK: %[[ext0:.*]] = arith.addi
+    ! CHECK: subi
+    ! CHECK: %[[ext1:.*]] = arith.addi
+    ! CHECK: %[[shape:.*]] = fir.shape_shift %{{.*}}, %[[ext0]], %{{.*}}, %[[ext1]]
+    ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shape]]) : (!fir.box<!fir.array<?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+    ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+    p(2:11, 3:12) => x
+  end subroutine
+  
+  ! Test remapping a slice
+  
+  ! CHECK-LABEL: func @_QPtest_array_non_contig_remap_slice(
+  ! CHECK-SAME:                                             %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>{{.*}}, %[[VAL_1:.*]]: !fir.ref<!fir.array<400xf32>> {{{.*}}, fir.target}) {
+  ! CHECK:         %[[VAL_2:.*]] = arith.constant 400 : index
+  ! CHECK:         %[[VAL_3:.*]] = arith.constant 2 : i64
+  ! CHECK:         %[[VAL_4:.*]] = arith.constant 11 : i64
+  ! CHECK:         %[[VAL_5:.*]] = arith.constant 3 : i64
+  ! CHECK:         %[[VAL_6:.*]] = arith.constant 12 : i64
+  ! CHECK:         %[[VAL_7:.*]] = arith.constant 51 : i64
+  ! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
+  ! CHECK:         %[[VAL_9:.*]] = arith.constant 3 : i64
+  ! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index
+  ! CHECK:         %[[VAL_11:.*]] = arith.constant 350 : i64
+  ! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
+  ! CHECK:         %[[VAL_13:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
+  ! CHECK:         %[[VAL_14:.*]] = fir.slice %[[VAL_8]], %[[VAL_12]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1>
+  ! CHECK:         %[[VAL_15:.*]] = fir.embox %[[VAL_1]](%[[VAL_13]]) {{\[}}%[[VAL_14]]] : (!fir.ref<!fir.array<400xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_16:.*]] = arith.constant 1 : index
+  ! CHECK:         %[[VAL_17:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
+  ! CHECK:         %[[VAL_18:.*]] = fir.convert %[[VAL_4]] : (i64) -> index
+  ! CHECK:         %[[VAL_19:.*]] = arith.subi %[[VAL_18]], %[[VAL_17]] : index
+  ! CHECK:         %[[VAL_20:.*]] = arith.addi %[[VAL_19]], %[[VAL_16]] : index
+  ! CHECK:         %[[VAL_21:.*]] = fir.convert %[[VAL_5]] : (i64) -> index
+  ! CHECK:         %[[VAL_22:.*]] = fir.convert %[[VAL_6]] : (i64) -> index
+  ! CHECK:         %[[VAL_23:.*]] = arith.subi %[[VAL_22]], %[[VAL_21]] : index
+  ! CHECK:         %[[VAL_24:.*]] = arith.addi %[[VAL_23]], %[[VAL_16]] : index
+  ! CHECK:         %[[VAL_25:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
+  ! CHECK:         %[[VAL_26:.*]] = fir.convert %[[VAL_5]] : (i64) -> index
+  ! CHECK:         %[[VAL_27:.*]] = fir.shape_shift %[[VAL_25]], %[[VAL_20]], %[[VAL_26]], %[[VAL_24]] : (index, index, index, index) -> !fir.shapeshift<2>
+  ! CHECK:         %[[VAL_28:.*]] = fir.rebox %[[VAL_15]](%[[VAL_27]]) : (!fir.box<!fir.array<?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+  ! CHECK:         fir.store %[[VAL_28]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+  ! CHECK:         return
+  ! CHECK:       }
+  subroutine test_array_non_contig_remap_slice(p, x)
+    real, target :: x(400)
+    real, pointer :: p(:, :)
+    p(2:11, 3:12) => x(51:350:3)
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !  Test pointer assignments that involves LHS pointers lowered to local variables
+  !  instead of a fir.ref<fir.box>, and RHS that are fir.box
+  ! -----------------------------------------------------------------------------
+  
+  ! CHECK-LABEL: func @_QPissue857(
+  ! CHECK-SAME: %[[rhs:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>>>
+  subroutine issue857(rhs)
+    type t
+      integer :: i
+    end type
+    type(t), pointer :: rhs, lhs
+    ! CHECK: %[[lhs:.*]] = fir.alloca !fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>
+    ! CHECK: %[[box_load:.*]] = fir.load %[[rhs]] : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>>>
+    ! CHECK: %[[addr:.*]] = fir.box_addr %[[box_load]] : (!fir.box<!fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>>) -> !fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>
+    ! CHECK: fir.store %[[addr]] to %[[lhs]] : !fir.ref<!fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>>
+    lhs => rhs
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPissue857_array(
+  ! CHECK-SAME: %[[rhs:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>>
+  subroutine issue857_array(rhs)
+    type t
+      integer :: i
+    end type
+    type(t), contiguous,  pointer :: rhs(:), lhs(:)
+    ! CHECK-DAG: %[[lhs_addr:.*]] = fir.alloca !fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>> {uniq_name = "_QFissue857_arrayElhs.addr"}
+    ! CHECK-DAG: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_arrayElhs.lb0"}
+    ! CHECK-DAG: %[[lhs_ext:.*]] = fir.alloca index {uniq_name = "_QFissue857_arrayElhs.ext0"}
+    ! CHECK: %[[box:.*]] = fir.load %[[rhs]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>>
+    ! CHECK: %[[lb:.*]]:3 = fir.box_dims %[[box]], %c{{.*}} : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>, index) -> (index, index, index)
+    ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>) -> !fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>
+    ! CHECK: %[[ext:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>, index) -> (index, index, index)
+    ! CHECK-DAG: fir.store %[[addr]] to %[[lhs_addr]] : !fir.ref<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>
+    ! CHECK-DAG: fir.store %[[ext]]#1 to %[[lhs_ext]] : !fir.ref<index>
+    ! CHECK-DAG: fir.store %[[lb]]#0 to %[[lhs_lb]] : !fir.ref<index>
+    lhs => rhs
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPissue857_array_shift(
+  subroutine issue857_array_shift(rhs)
+    ! Test lower bounds is the one from the shift
+    type t
+      integer :: i
+    end type
+    type(t), contiguous,  pointer :: rhs(:), lhs(:)
+    ! CHECK: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_shiftElhs.lb0"}
+    ! CHECK: %[[c42:.*]] = fir.convert %c42{{.*}} : (i64) -> index
+    ! CHECK: fir.store %[[c42]] to %[[lhs_lb]] : !fir.ref<index>
+    lhs(42:) => rhs
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPissue857_array_remap
+  subroutine issue857_array_remap(rhs)
+    ! Test lower bounds is the one from the shift
+    type t
+      integer :: i
+    end type
+    type(t), contiguous,  pointer :: rhs(:, :), lhs(:)
+    ! CHECK-DAG: %[[lhs_addr:.*]] = fir.alloca !fir.ptr<!fir.array<?x!fir.type<_QFissue857_array_remapTt{i:i32}>>> {uniq_name = "_QFissue857_array_remapElhs.addr"}
+    ! CHECK-DAG: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_remapElhs.lb0"}
+    ! CHECK-DAG: %[[lhs_ext:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_remapElhs.ext0"}
+  
+    ! CHECK: %[[c101:.*]] = fir.convert %c101_i64 : (i64) -> index
+    ! CHECK: %[[c200:.*]] = fir.convert %c200_i64 : (i64) -> index
+    ! CHECK: %[[sub:.*]] = arith.subi %[[c200]], %[[c101]] : index
+    ! CHECK: %[[extent:.*]] = arith.addi %[[sub]], %c1{{.*}} : index
+    ! CHECK: %[[addr:.*]] = fir.box_addr %{{.*}} : (!fir.box<!fir.ptr<!fir.array<?x?x!fir.type<_QFissue857_array_remapTt{i:i32}>>>>) -> !fir.ptr<!fir.array<?x?x!fir.type<_QFissue857_array_remapTt{i:i32}>>>
+    ! CHECK: %[[addr_cast:.*]] = fir.convert %[[addr]] : (!fir.ptr<!fir.array<?x?x!fir.type<_QFissue857_array_remapTt{i:i32}>>>) -> !fir.ptr<!fir.array<?x!fir.type<_QFissue857_array_remapTt{i:i32}>>>
+    ! CHECK: fir.store %[[addr_cast]] to %[[lhs_addr]] : !fir.ref<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_array_remapTt{i:i32}>>>>
+    ! CHECK: fir.store %[[extent]] to %[[lhs_ext]] : !fir.ref<index>
+    ! CHECK: %[[c101_2:.*]] = fir.convert %c101{{.*}} : (i64) -> index
+    ! CHECK: fir.store %[[c101_2]] to %[[lhs_lb]] : !fir.ref<index>
+    lhs(101:200) => rhs
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPissue857_char
+  subroutine issue857_char(rhs)
+    ! Only check that the length is taken from the fir.box created for the slice.
+    ! CHECK-DAG: %[[lhs1_len:.*]] = fir.alloca index {uniq_name = "_QFissue857_charElhs1.len"}
+    ! CHECK-DAG: %[[lhs2_len:.*]] = fir.alloca index {uniq_name = "_QFissue857_charElhs2.len"}
+    character(:), contiguous,  pointer ::  lhs1(:), lhs2(:, :)
+    character(*), target ::  rhs(100)
+    ! CHECK: %[[len:.*]] = fir.box_elesize %{{.*}} : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
+    ! CHECK: fir.store %[[len]] to %[[lhs1_len]] : !fir.ref<index>
+    lhs1 => rhs(1:50:1)
+    ! CHECK: %[[len2:.*]] = fir.box_elesize %{{.*}} : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
+    ! CHECK: fir.store %[[len2]] to %[[lhs2_len]] : !fir.ref<index>
+    lhs2(1:2, 1:25) => rhs(1:50:1)
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPissue1180(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<i32> {{{.*}}, fir.target}) {
+  subroutine issue1180(x)
+    integer, target :: x
+    integer, pointer :: p
+    common /some_common/ p
+    ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QBsome_common) : !fir.ref<!fir.array<24xi8>>
+    ! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<24xi8>>) -> !fir.ref<!fir.array<?xi8>>
+    ! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index
+    ! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+    ! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<i8>) -> !fir.ref<!fir.box<!fir.ptr<i32>>>
+    ! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<i32>) -> !fir.box<!fir.ptr<i32>>
+    ! CHECK: fir.store %[[VAL_6]] to %[[VAL_5]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+    p => x
+  end subroutine

flang/test/Lower/pointer-disassociate.f90

+! Test lowering of pointer disassociation
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+
+! -----------------------------------------------------------------------------
+!     Test p => NULL()
+! -----------------------------------------------------------------------------
+
+
+! CHECK-LABEL: func @_QPtest_scalar(
+! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}})
+subroutine test_scalar(p)
+    real, pointer :: p
+    ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<f32>
+    ! CHECK: %[[box:.*]] = fir.embox %[[null]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+    p => NULL()
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPtest_scalar_char(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>{{.*}})
+  subroutine test_scalar_char(p)
+    character(:), pointer :: p
+    ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<!fir.char<1,?>>
+    ! CHECK: %[[box:.*]] = fir.embox %[[null]] typeparams %c0{{.*}} : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+    p => NULL()
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPtest_array(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}})
+  subroutine test_array(p)
+    real, pointer :: p(:)
+    ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+    ! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}}
+    ! CHECK: %[[box:.*]] = fir.embox %[[null]](%[[shape]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    p => NULL()
+  end subroutine
+  
+  ! Test p(lb, ub) => NULL() which is none sens but is not illegal.
+  ! CHECK-LABEL: func @_QPtest_array_remap(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}})
+  subroutine test_array_remap(p)
+    real, pointer :: p(:)
+    ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+    ! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}}
+    ! CHECK: %[[box:.*]] = fir.embox %[[null]](%[[shape]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    p(10:20) => NULL()
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !     Test p => NULL(MOLD)
+  ! -----------------------------------------------------------------------------
+  
+  ! CHECK-LABEL: func @_QPtest_scalar_mold(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{[^,]*}},
+  subroutine test_scalar_mold(p, x)
+    real, pointer :: p, x
+    ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<f32>>
+    ! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<f32>
+    ! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_1]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
+    ! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+    ! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+    ! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
+    ! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_4]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
+    ! CHECK: fir.store %[[VAL_5]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+    p => NULL(x)
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPtest_scalar_char_mold(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>{{[^,]*}},
+  subroutine test_scalar_char_mold(p, x)
+    character(:), pointer :: p, x
+    ! CHECK: %[[VAL_7:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.char<1,?>>>
+    ! CHECK: %[[VAL_8:.*]] = fir.zero_bits !fir.ptr<!fir.char<1,?>>
+    ! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index
+    ! CHECK: %[[VAL_10:.*]] = fir.embox %[[VAL_8]] typeparams %[[VAL_9]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
+    ! CHECK: fir.store %[[VAL_10]] to %[[VAL_7]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+    ! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_7]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+    ! CHECK: %[[VAL_12:.*]] = fir.box_elesize %[[VAL_11]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
+    ! CHECK: %[[VAL_13:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.ptr<!fir.char<1,?>>
+    ! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_13]] typeparams %[[VAL_12]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
+    ! CHECK: fir.store %[[VAL_14]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+    p => NULL(x)
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPtest_array_mold(
+  ! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{[^,]*}},
+  subroutine test_array_mold(p, x)
+    real, pointer :: p(:), x(:)
+    ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+    ! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index
+    ! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
+    ! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    ! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    ! CHECK: %[[VAL_6:.*]] = arith.constant 0 : index
+    ! CHECK: %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_5]], %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
+    ! CHECK: %[[VAL_8:.*]] = fir.shift %[[VAL_7]]#0 : (index) -> !fir.shift<1>
+    ! CHECK: %[[VAL_9:.*]] = fir.rebox %[[VAL_5]](%[[VAL_8]]) : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: fir.store %[[VAL_9]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    p => NULL(x)
+  end subroutine

flang/test/Lower/pointer-initial-target-2.f90

+! Test lowering of pointer initial target
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! This tests focus on the scope context of initial data target.
+! More complete tests regarding the initial data target expression
+! are done in pointer-initial-target.f90.
+
+! Test pointer initial data target in modules
+module some_mod
+    real, target :: x(100)
+    real, pointer :: p(:) => x
+  ! CHECK-LABEL: fir.global @_QMsome_modEp : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
+    ! CHECK: %[[x:.*]] = fir.address_of(@_QMsome_modEx) : !fir.ref<!fir.array<100xf32>>
+    ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1>
+    ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
+  end module
+  
+  ! Test initial data target in a common block
+  module some_mod_2
+    real, target :: x(100), y(10:209)
+    common /com/ x, y
+    save :: /com/
+    real, pointer :: p(:) => y
+  ! CHECK-LABEL: fir.global @_QMsome_mod_2Ep : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
+    ! CHECK: %[[c:.*]] = fir.address_of(@_QBcom) : !fir.ref<!fir.array<1200xi8>>
+    ! CHECK: %[[com:.*]] = fir.convert %[[c]] : (!fir.ref<!fir.array<1200xi8>>) -> !fir.ref<!fir.array<?xi8>>
+    ! CHECK: %[[yRaw:.*]] = fir.coordinate_of %[[com]], %c400{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+    ! CHECK: %[[y:.*]] = fir.convert %[[yRaw]] : (!fir.ref<i8>) -> !fir.ref<!fir.array<200xf32>>
+    ! CHECK: %[[shape:.*]] = fir.shape_shift %c10{{.*}}, %c200{{.*}} : (index, index) -> !fir.shapeshift<1>
+    ! CHECK: %[[box:.*]] = fir.embox %[[y]](%[[shape]]) : (!fir.ref<!fir.array<200xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
+  end module
+  
+  ! Test pointer initial data target with pointer in common blocks
+  block data
+    real, pointer :: p
+    real, save, target :: b
+    common /a/ p
+    data p /b/
+  ! CHECK-LABEL: fir.global @_QBa : tuple<!fir.box<!fir.ptr<f32>>>
+    ! CHECK: %[[undef:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<f32>>>
+    ! CHECK: %[[b:.*]] = fir.address_of(@_QEb) : !fir.ref<f32>
+    ! CHECK: %[[box:.*]] = fir.embox %[[b]] : (!fir.ref<f32>) -> !fir.box<!fir.ptr<f32>>
+    ! CHECK: %[[a:.*]] = fir.insert_value %[[undef]], %[[box]], [0 : index] : (tuple<!fir.box<!fir.ptr<f32>>>, !fir.box<!fir.ptr<f32>>) -> tuple<!fir.box<!fir.ptr<f32>>>
+    ! CHECK: fir.has_value %[[a]] : tuple<!fir.box<!fir.ptr<f32>>>
+  end block data
+  
+  ! Test pointer in a common with initial target in the same common.
+  block data snake
+    integer, target :: b = 42
+    integer, pointer :: p => b
+    common /snake/ p, b
+  ! CHECK-LABEL: fir.global @_QBsnake : tuple<!fir.box<!fir.ptr<i32>>, i32>
+    ! CHECK: %[[tuple0:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<i32>>, i32>
+    ! CHECK: %[[snakeAddr:.*]] = fir.address_of(@_QBsnake) : !fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>
+    ! CHECK: %[[byteView:.*]] = fir.convert %[[snakeAddr:.*]] : (!fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>) -> !fir.ref<!fir.array<?xi8>>
+    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[byteView]], %c24{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+    ! CHECK: %[[bAddr:.*]] = fir.convert %[[coor]] : (!fir.ref<i8>) -> !fir.ref<i32>
+    ! CHECK: %[[box:.*]] = fir.embox %[[bAddr]] : (!fir.ref<i32>) -> !fir.box<!fir.ptr<i32>>
+    ! CHECK: %[[tuple1:.*]] = fir.insert_value %[[tuple0]], %[[box]], [0 : index] : (tuple<!fir.box<!fir.ptr<i32>>, i32>, !fir.box<!fir.ptr<i32>>) -> tuple<!fir.box<!fir.ptr<i32>>, i32>
+    ! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple1]], %c42{{.*}}, [1 : index] : (tuple<!fir.box<!fir.ptr<i32>>, i32>, i32) -> tuple<!fir.box<!fir.ptr<i32>>, i32>
+    ! CHECK: fir.has_value %[[tuple2]] : tuple<!fir.box<!fir.ptr<i32>>, i32>
+  end block data
+  
+  ! Test two common depending on each others because of initial data
+  ! targets
+  block data tied
+    real, target :: x1 = 42
+    real, target :: x2 = 43
+    real, pointer :: p1 => x2
+    real, pointer :: p2 => x1
+    common /c1/ x1, p1
+    common /c2/ x2, p2
+  ! CHECK-LABEL: fir.global @_QBc1 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
+    ! CHECK: fir.address_of(@_QBc2) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
+  ! CHECK-LABEL: fir.global @_QBc2 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
+    ! CHECK: fir.address_of(@_QBc1) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
+  end block data

flang/test/Lower/pointer-initial-target.f90

+! Test lowering of pointer initial target
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! -----------------------------------------------------------------------------
+!     Test scalar initial data target that are simple names
+! -----------------------------------------------------------------------------
+
+subroutine scalar()
+    real, save, target :: x
+    real, pointer :: p => x
+  ! CHECK-LABEL: fir.global internal @_QFscalarEp : !fir.box<!fir.ptr<f32>>
+    ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalarEx) : !fir.ref<f32>
+    ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<f32>) -> !fir.box<!fir.ptr<f32>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<f32>>
+  end subroutine
+  
+  subroutine scalar_char()
+    character(10), save, target :: x
+    character(:), pointer :: p => x
+  ! CHECK-LABEL: fir.global internal @_QFscalar_charEp : !fir.box<!fir.ptr<!fir.char<1,?>>>
+    ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_charEx) : !fir.ref<!fir.char<1,10>>
+    ! CHECK: %[[xCast:.*]] = fir.convert %[[x]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ptr<!fir.char<1,?>>
+    ! CHECK: %[[box:.*]] = fir.embox %[[xCast]] typeparams %c10{{.*}} : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.char<1,?>>>
+  end subroutine
+  
+  subroutine scalar_char_2()
+    character(10), save, target :: x
+    character(10), pointer :: p => x
+  ! CHECK-LABEL: fir.global internal @_QFscalar_char_2Ep : !fir.box<!fir.ptr<!fir.char<1,10>>>
+    ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_char_2Ex) : !fir.ref<!fir.char<1,10>>
+    ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.ptr<!fir.char<1,10>>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.char<1,10>>>
+  end subroutine
+  
+  subroutine scalar_derived()
+    type t
+      real :: x
+      integer :: i
+    end type
+    type(t), save, target :: x
+    type(t), pointer :: p => x
+  ! CHECK-LABEL: fir.global internal @_QFscalar_derivedEp : !fir.box<!fir.ptr<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>>
+    ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_derivedEx) : !fir.ref<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>
+    ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>) -> !fir.box<!fir.ptr<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>>
+  end subroutine
+  
+  subroutine scalar_null()
+    real, pointer :: p => NULL()
+  ! CHECK-LABEL: fir.global internal @_QFscalar_nullEp : !fir.box<!fir.ptr<f32>>
+    ! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr<f32>
+    ! CHECK: %[[box:.*]] = fir.embox %[[zero]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<f32>>
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !     Test array initial data target that are simple names
+  ! -----------------------------------------------------------------------------
+  
+  subroutine array()
+    real, save, target :: x(100)
+    real, pointer :: p(:) => x
+  ! CHECK-LABEL: fir.global internal @_QFarrayEp : !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: %[[x:.*]] = fir.address_of(@_QFarrayEx) : !fir.ref<!fir.array<100xf32>>
+    ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1>
+    ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
+  end subroutine
+  
+  subroutine array_char()
+    character(10), save, target :: x(20)
+    character(:), pointer :: p(:) => x
+  ! CHECK-LABEL: fir.global internal @_QFarray_charEp : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
+    ! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_charEx) : !fir.ref<!fir.array<20x!fir.char<1,10>>>
+    ! CHECK: %[[shape:.*]] = fir.shape %c20{{.*}} : (index) -> !fir.shape<1>
+    ! CHECK: %[[xCast:.*]] = fir.convert %[[x]] : (!fir.ref<!fir.array<20x!fir.char<1,10>>>) -> !fir.ptr<!fir.array<?x!fir.char<1,?>>>
+    ! CHECK: %[[box:.*]] = fir.embox %[[xCast]](%[[shape]]) typeparams %c10{{.*}} : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
+  end subroutine
+  
+  subroutine array_char_2()
+    character(10), save, target :: x(20)
+    character(10), pointer :: p(:) => x
+  ! CHECK-LABEL: fir.global internal @_QFarray_char_2Ep : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>
+    ! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_char_2Ex) : !fir.ref<!fir.array<20x!fir.char<1,10>>>
+    ! CHECK: %[[shape:.*]] = fir.shape %c20{{.*}} : (index) -> !fir.shape<1>
+    ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<20x!fir.char<1,10>>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>
+  end subroutine
+  
+  subroutine array_derived()
+    type t
+      real :: x
+      integer :: i
+    end type
+    type(t), save, target :: x(100)
+    type(t), pointer :: p(:) => x
+  ! CHECK-LABEL: fir.global internal @_QFarray_derivedEp : !fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>>
+    ! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_derivedEx) : !fir.ref<!fir.array<100x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>
+    ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1>
+    ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>>
+  end subroutine
+  
+  subroutine array_null()
+    real, pointer :: p(:) => NULL()
+  ! CHECK-LABEL: fir.global internal @_QFarray_nullEp : !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+    ! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
+    ! CHECK: %[[box:.*]] = fir.embox %[[zero]](%[[shape]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !     Test scalar initial data target that are data references
+  ! -----------------------------------------------------------------------------
+  
+  subroutine scalar_ref()
+    real, save, target :: x(4:100)
+    real, pointer :: p => x(50)
+  ! CHECK-LABEL: fir.global internal @_QFscalar_refEp : !fir.box<!fir.ptr<f32>> {
+    ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_refEx) : !fir.ref<!fir.array<97xf32>>
+    ! CHECK: %[[lb:.*]] = fir.convert %c4 : (index) -> i64
+    ! CHECK: %[[idx:.*]] = arith.subi %c50{{.*}}, %[[lb]] : i64
+    ! CHECK: %[[elt:.*]] = fir.coordinate_of %[[x]], %[[idx]] : (!fir.ref<!fir.array<97xf32>>, i64) -> !fir.ref<f32>
+    ! CHECK: %[[box:.*]] = fir.embox %[[elt]] : (!fir.ref<f32>) -> !fir.box<!fir.ptr<f32>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<f32>>
+  end subroutine
+  
+  subroutine scalar_char_ref()
+    character(20), save, target :: x(100)
+    character(10), pointer :: p => x(6)(7:16)
+  ! CHECK-LABEL: fir.global internal @_QFscalar_char_refEp : !fir.box<!fir.ptr<!fir.char<1,10>>>
+    ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_char_refEx) : !fir.ref<!fir.array<100x!fir.char<1,20>>>
+    ! CHECK: %[[idx:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64
+    ! CHECK: %[[elt:.*]] = fir.coordinate_of %[[x]], %[[idx]] : (!fir.ref<!fir.array<100x!fir.char<1,20>>>, i64) -> !fir.ref<!fir.char<1,20>>
+    ! CHECK: %[[eltCast:.*]] = fir.convert %[[elt:.*]] : (!fir.ref<!fir.char<1,20>>) -> !fir.ref<!fir.array<20x!fir.char<1>>>
+    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[eltCast]], %{{.*}} : (!fir.ref<!fir.array<20x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+    ! CHECK: %[[substring:.*]] = fir.convert %[[coor]] : (!fir.ref<!fir.char<1>>) -> !fir.ref<!fir.char<1,?>>
+    ! CHECK: %[[substringCast:.*]] = fir.convert %[[substring]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ptr<!fir.char<1,10>>
+    ! CHECK: %[[box:.*]] = fir.embox %[[substringCast]] : (!fir.ptr<!fir.char<1,10>>) -> !fir.box<!fir.ptr<!fir.char<1,10>>>
+    ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.char<1,10>>>
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !     Test array initial data target that are data references
+  ! -----------------------------------------------------------------------------
+  
+  
+  subroutine array_ref()
+    real, save, target :: x(4:103, 5:104)
+    real, pointer :: p(:) => x(10, 20:100:2)
+  end subroutine
+  
+  ! CHECK-LABEL: fir.global internal @_QFarray_refEp : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
+  ! CHECK:         %[[VAL_0:.*]] = fir.address_of(@_QFarray_refEx) : !fir.ref<!fir.array<100x100xf32>>
+  ! CHECK:         %[[VAL_1:.*]] = arith.constant 4 : index
+  ! CHECK:         %[[VAL_2:.*]] = arith.constant 100 : index
+  ! CHECK:         %[[VAL_3:.*]] = arith.constant 5 : index
+  ! CHECK:         %[[VAL_4:.*]] = arith.constant 100 : index
+  ! CHECK:         %[[VAL_5:.*]] = arith.constant 1 : index
+  ! CHECK:         %[[VAL_6:.*]] = arith.constant 1 : index
+  ! CHECK:         %[[VAL_7:.*]] = arith.constant 10 : i64
+  ! CHECK:         %[[VAL_8:.*]] = fir.undefined index
+  ! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
+  ! CHECK:         %[[VAL_10:.*]] = arith.subi %[[VAL_9]], %[[VAL_1]] : index
+  ! CHECK:         %[[VAL_11:.*]] = arith.constant 20 : i64
+  ! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
+  ! CHECK:         %[[VAL_13:.*]] = arith.constant 2 : i64
+  ! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i64) -> index
+  ! CHECK:         %[[VAL_15:.*]] = arith.constant 100 : i64
+  ! CHECK:         %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i64) -> index
+  ! CHECK:         %[[VAL_17:.*]] = arith.constant 0 : index
+  ! CHECK:         %[[VAL_18:.*]] = arith.subi %[[VAL_16]], %[[VAL_12]] : index
+  ! CHECK:         %[[VAL_19:.*]] = arith.addi %[[VAL_18]], %[[VAL_14]] : index
+  ! CHECK:         %[[VAL_20:.*]] = arith.divsi %[[VAL_19]], %[[VAL_14]] : index
+  ! CHECK:         %[[VAL_21:.*]] = arith.cmpi sgt, %[[VAL_20]], %[[VAL_17]] : index
+  ! CHECK:         %[[VAL_22:.*]] = arith.select %[[VAL_21]], %[[VAL_20]], %[[VAL_17]] : index
+  ! CHECK:         %[[VAL_23:.*]] = fir.shape_shift %[[VAL_1]], %[[VAL_2]], %[[VAL_3]], %[[VAL_4]] : (index, index, index, index) -> !fir.shapeshift<2>
+  ! CHECK:         %[[VAL_24:.*]] = fir.slice %[[VAL_7]], %[[VAL_8]], %[[VAL_8]], %[[VAL_12]], %[[VAL_16]], %[[VAL_14]] : (i64, index, index, index, index, index) -> !fir.slice<2>
+  ! CHECK:         %[[VAL_25:.*]] = fir.embox %[[VAL_0]](%[[VAL_23]]) {{\[}}%[[VAL_24]]] : (!fir.ref<!fir.array<100x100xf32>>, !fir.shapeshift<2>, !fir.slice<2>) -> !fir.box<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_26:.*]] = fir.embox %[[VAL_0]](%[[VAL_23]]) {{\[}}%[[VAL_24]]] : (!fir.ref<!fir.array<100x100xf32>>, !fir.shapeshift<2>, !fir.slice<2>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+  ! CHECK:         fir.has_value %[[VAL_26]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
+  ! CHECK:       }
+  
 No newline at end of file

flang/test/Lower/pointer-reference.f90

+! Test lowering of references to pointers
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Assigning/reading to scalar pointer target.
+! CHECK-LABEL: func @_QPscal_ptr(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}})
+subroutine scal_ptr(p)
+    real, pointer :: p
+    real :: x
+    ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]]
+    ! CHECK: %[[addr:.*]] = fir.box_addr %[[boxload]]
+    ! CHECK: fir.store %{{.*}} to %[[addr]]
+    p = 3.
+  
+    ! CHECK: %[[boxload2:.*]] = fir.load %[[arg0]]
+    ! CHECK: %[[addr2:.*]] = fir.box_addr %[[boxload2]]
+    ! CHECK: %[[val:.*]] = fir.load %[[addr2]]
+    ! CHECK: fir.store %[[val]] to %{{.*}}
+    x = p
+  end subroutine
+  
+  ! Assigning/reading scalar character pointer target.
+  ! CHECK-LABEL: func @_QPchar_ptr(
+  ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,12>>>>{{.*}})
+  subroutine char_ptr(p)
+    character(12), pointer :: p
+    character(12) :: x
+  
+    ! CHECK-DAG: %[[str:.*]] = fir.address_of(@_QQcl.68656C6C6F20776F726C6421) : !fir.ref<!fir.char<1,12>>
+    ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]]
+    ! CHECK: %[[addr:.*]] = fir.box_addr %[[boxload]]
+    ! CHECK-DAG: %[[one:.*]] = arith.constant 1
+    ! CHECK-DAG: %[[size:.*]] = fir.convert %{{.*}} : (index) -> i64
+    ! CHECK: %[[count:.*]] = arith.muli %[[one]], %[[size]] : i64
+    ! CHECK: %[[dst:.*]] = fir.convert %[[addr]] : (!fir.ptr<!fir.char<1,12>>) -> !fir.ref<i8>
+    ! CHECK: %[[src:.*]] = fir.convert %[[str]] : (!fir.ref<!fir.char<1,12>>) -> !fir.ref<i8>
+    ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[dst]], %[[src]], %5, %false) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+    p = "hello world!"
+  
+    ! CHECK: %[[boxload2:.*]] = fir.load %[[arg0]]
+    ! CHECK: %[[addr2:.*]] = fir.box_addr %[[boxload2]]
+    ! CHECK: %[[count:.*]] = arith.muli %{{.*}}, %{{.*}} : i64
+    ! CHECK: %[[dst:.*]] = fir.convert %{{.*}} : (!fir.ref<!fir.char<1,12>>) -> !fir.ref<i8>
+    ! CHECK: %[[src:.*]] = fir.convert %[[addr2]] : (!fir.ptr<!fir.char<1,12>>) -> !fir.ref<i8>
+    ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[dst]], %[[src]], %[[count]], %{{.*}}) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+    x = p
+  end subroutine
+  
+  ! Reading from pointer in array expression
+  ! CHECK-LABEL: func @_QParr_ptr_read(
+  ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}})
+  subroutine arr_ptr_read(p)
+    real, pointer :: p(:)
+    real :: x(100)
+    ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]]
+    ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[boxload]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
+    ! CHECK: %[[lb:.*]] = fir.shift %[[dims]]#0 : (index) -> !fir.shift<1>
+    ! CHECK: fir.array_load %[[boxload]](%[[lb]]) : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>) -> !fir.array<?xf32>
+    x = p
+  end subroutine
+  
+  ! Reading from contiguous pointer in array expression
+  ! CHECK-LABEL: func @_QParr_contig_ptr_read(
+  ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {{{.*}}, fir.contiguous})
+  subroutine arr_contig_ptr_read(p)
+    real, pointer, contiguous :: p(:)
+    real :: x(100)
+    ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]]
+    ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[boxload]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
+    ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[boxload]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+    ! CHECK-DAG: %[[shape:.*]] = fir.shape_shift %[[dims]]#0, %[[dims]]#1 : (index, index) -> !fir.shapeshift<1>
+    ! CHECK: fir.array_load %[[addr]](%[[shape]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.array<?xf32>
+    x = p
+  end subroutine
+  
+  ! Assigning to pointer target in array expression
+  
+    ! CHECK-LABEL: func @_QParr_ptr_target_write(
+    ! CHECK-SAME:                                %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}) {
+    ! CHECK:         %[[VAL_1:.*]] = arith.constant 100 : index
+    ! CHECK:         %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = "x", uniq_name = "_QFarr_ptr_target_writeEx"}
+    ! CHECK:         %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    ! CHECK:         %[[VAL_4:.*]] = arith.constant 0 : index
+    ! CHECK:         %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
+    ! CHECK:         %[[VAL_6:.*]] = arith.constant 2 : i64
+    ! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> index
+    ! CHECK:         %[[VAL_8:.*]] = arith.constant 6 : i64
+    ! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index
+    ! CHECK:         %[[VAL_10:.*]] = arith.constant 601 : i64
+    ! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index
+    ! CHECK:         %[[VAL_12:.*]] = arith.constant 0 : index
+    ! CHECK:         %[[VAL_13:.*]] = arith.subi %[[VAL_11]], %[[VAL_7]] : index
+    ! CHECK:         %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_9]] : index
+    ! CHECK:         %[[VAL_15:.*]] = arith.divsi %[[VAL_14]], %[[VAL_9]] : index
+    ! CHECK:         %[[VAL_16:.*]] = arith.cmpi sgt, %[[VAL_15]], %[[VAL_12]] : index
+    ! CHECK:         %[[VAL_17:.*]] = arith.select %[[VAL_16]], %[[VAL_15]], %[[VAL_12]] : index
+    ! CHECK:         %[[VAL_18:.*]] = fir.shift %[[VAL_5]]#0 : (index) -> !fir.shift<1>
+    ! CHECK:         %[[VAL_19:.*]] = fir.slice %[[VAL_7]], %[[VAL_11]], %[[VAL_9]] : (index, index, index) -> !fir.slice<1>
+    ! CHECK:         %[[VAL_20:.*]] = fir.array_load %[[VAL_3]](%[[VAL_18]]) {{\[}}%[[VAL_19]]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>, !fir.slice<1>) -> !fir.array<?xf32>
+    ! CHECK:         %[[VAL_21:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+    ! CHECK:         %[[VAL_22:.*]] = fir.array_load %[[VAL_2]](%[[VAL_21]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.array<100xf32>
+    ! CHECK:         %[[VAL_23:.*]] = arith.constant 1 : index
+    ! CHECK:         %[[VAL_24:.*]] = arith.constant 0 : index
+    ! CHECK:         %[[VAL_25:.*]] = arith.subi %[[VAL_17]], %[[VAL_23]] : index
+    ! CHECK:         %[[VAL_26:.*]] = fir.do_loop %[[VAL_27:.*]] = %[[VAL_24]] to %[[VAL_25]] step %[[VAL_23]] unordered iter_args(%[[VAL_28:.*]] = %[[VAL_20]]) -> (!fir.array<?xf32>) {
+    ! CHECK:           %[[VAL_29:.*]] = fir.array_fetch %[[VAL_22]], %[[VAL_27]] : (!fir.array<100xf32>, index) -> f32
+    ! CHECK:           %[[VAL_30:.*]] = fir.array_update %[[VAL_28]], %[[VAL_29]], %[[VAL_27]] : (!fir.array<?xf32>, f32, index) -> !fir.array<?xf32>
+    ! CHECK:           fir.result %[[VAL_30]] : !fir.array<?xf32>
+    ! CHECK:         }
+    ! CHECK:         fir.array_merge_store %[[VAL_20]], %[[VAL_31:.*]] to %[[VAL_3]]{{\[}}%[[VAL_19]]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.slice<1>
+    ! CHECK:         return
+    ! CHECK:       }
+  
+  subroutine arr_ptr_target_write(p)
+    real, pointer :: p(:)
+    real :: x(100)
+    p(2:601:6) = x
+  end subroutine
+  
+  ! Assigning to contiguous pointer target in array expression
+  
+    ! CHECK-LABEL: func @_QParr_contig_ptr_target_write(
+    ! CHECK-SAME:                                       %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {{{.*}}, fir.contiguous}) {
+    ! CHECK:         %[[VAL_1:.*]] = arith.constant 100 : index
+    ! CHECK:         %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = "x", uniq_name = "_QFarr_contig_ptr_target_writeEx"}
+    ! CHECK:         %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    ! CHECK:         %[[VAL_4:.*]] = arith.constant 0 : index
+    ! CHECK:         %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
+    ! CHECK:         %[[VAL_6:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+    ! CHECK:         %[[VAL_7:.*]] = arith.constant 2 : i64
+    ! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
+    ! CHECK:         %[[VAL_9:.*]] = arith.constant 6 : i64
+    ! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index
+    ! CHECK:         %[[VAL_11:.*]] = arith.constant 601 : i64
+    ! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
+    ! CHECK:         %[[VAL_13:.*]] = arith.constant 0 : index
+    ! CHECK:         %[[VAL_14:.*]] = arith.subi %[[VAL_12]], %[[VAL_8]] : index
+    ! CHECK:         %[[VAL_15:.*]] = arith.addi %[[VAL_14]], %[[VAL_10]] : index
+    ! CHECK:         %[[VAL_16:.*]] = arith.divsi %[[VAL_15]], %[[VAL_10]] : index
+    ! CHECK:         %[[VAL_17:.*]] = arith.cmpi sgt, %[[VAL_16]], %[[VAL_13]] : index
+    ! CHECK:         %[[VAL_18:.*]] = arith.select %[[VAL_17]], %[[VAL_16]], %[[VAL_13]] : index
+    ! CHECK:         %[[VAL_19:.*]] = fir.shape_shift %[[VAL_5]]#0, %[[VAL_5]]#1 : (index, index) -> !fir.shapeshift<1>
+    ! CHECK:         %[[VAL_20:.*]] = fir.slice %[[VAL_8]], %[[VAL_12]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1>
+    ! CHECK:         %[[VAL_21:.*]] = fir.array_load %[[VAL_6]](%[[VAL_19]]) {{\[}}%[[VAL_20]]] : (!fir.ptr<!fir.array<?xf32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.array<?xf32>
+    ! CHECK:         %[[VAL_22:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+    ! CHECK:         %[[VAL_23:.*]] = fir.array_load %[[VAL_2]](%[[VAL_22]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.array<100xf32>
+    ! CHECK:         %[[VAL_24:.*]] = arith.constant 1 : index
+    ! CHECK:         %[[VAL_25:.*]] = arith.constant 0 : index
+    ! CHECK:         %[[VAL_26:.*]] = arith.subi %[[VAL_18]], %[[VAL_24]] : index
+    ! CHECK:         %[[VAL_27:.*]] = fir.do_loop %[[VAL_28:.*]] = %[[VAL_25]] to %[[VAL_26]] step %[[VAL_24]] unordered iter_args(%[[VAL_29:.*]] = %[[VAL_21]]) -> (!fir.array<?xf32>) {
+    ! CHECK:           %[[VAL_30:.*]] = fir.array_fetch %[[VAL_23]], %[[VAL_28]] : (!fir.array<100xf32>, index) -> f32
+    ! CHECK:           %[[VAL_31:.*]] = fir.array_update %[[VAL_29]], %[[VAL_30]], %[[VAL_28]] : (!fir.array<?xf32>, f32, index) -> !fir.array<?xf32>
+    ! CHECK:           fir.result %[[VAL_31]] : !fir.array<?xf32>
+    ! CHECK:         }
+    ! CHECK:         fir.array_merge_store %[[VAL_21]], %[[VAL_32:.*]] to %[[VAL_6]]{{\[}}%[[VAL_20]]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.ptr<!fir.array<?xf32>>, !fir.slice<1>
+    ! CHECK:         return
+    ! CHECK:       }
+  
+  subroutine arr_contig_ptr_target_write(p)
+    real, pointer, contiguous :: p(:)
+    real :: x(100)
+    p(2:601:6) = x
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPpointer_result_as_value
+  subroutine pointer_result_as_value()
+    ! Test that function pointer results used as values are correctly loaded.
+    interface
+      function returns_int_pointer()
+        integer, pointer :: returns_int_pointer
+      end function
+    end interface
+  ! CHECK:  %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<i32>> {bindc_name = ".result"}
+  ! CHECK:  %[[VAL_6:.*]] = fir.call @_QPreturns_int_pointer() : () -> !fir.box<!fir.ptr<i32>>
+  ! CHECK:  fir.save_result %[[VAL_6]] to %[[VAL_0]] : !fir.box<!fir.ptr<i32>>, !fir.ref<!fir.box<!fir.ptr<i32>>>
+  ! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+  ! CHECK:  %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
+  ! CHECK:  fir.load %[[VAL_8]] : !fir.ptr<i32>
+    print *, returns_int_pointer()
+  end subroutine

flang/test/Lower/pointer-results-as-arguments.f90

+! Test passing pointers results to pointer dummy arguments
+! RUN: bbc %s -o - | FileCheck %s
+
+module presults
+    interface
+      subroutine bar_scalar(x)
+        real, pointer :: x
+      end subroutine
+      subroutine bar(x)
+        real, pointer :: x(:, :)
+      end subroutine
+      function get_scalar_pointer()
+        real, pointer :: get_scalar_pointer
+      end function
+      function get_pointer()
+        real, pointer :: get_pointer(:, :)
+      end function
+    end interface
+    real, pointer :: x
+    real, pointer :: xa(:, :)
+  contains
+  
+  ! CHECK-LABEL: test_scalar_null
+  subroutine test_scalar_null()
+  ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<f32>>
+  ! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<f32>
+  ! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_1]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
+  ! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+  ! CHECK: fir.call @_QPbar_scalar(%[[VAL_0]]) : (!fir.ref<!fir.box<!fir.ptr<f32>>>) -> ()
+    call bar_scalar(null())
+  end subroutine
+  
+  ! CHECK-LABEL: test_scalar_null_mold
+  subroutine test_scalar_null_mold()
+  ! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box<!fir.ptr<f32>>
+  ! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<f32>
+  ! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_4]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
+  ! CHECK: fir.store %[[VAL_5]] to %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+  ! CHECK: fir.call @_QPbar_scalar(%[[VAL_3]]) : (!fir.ref<!fir.box<!fir.ptr<f32>>>) -> ()
+    call bar_scalar(null(x))
+  end subroutine
+  
+  ! CHECK-LABEL: test_scalar_result
+  subroutine test_scalar_result()
+  ! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.box<!fir.ptr<f32>> {bindc_name = ".result"}
+  ! CHECK: %[[VAL_7:.*]] = fir.call @_QPget_scalar_pointer() : () -> !fir.box<!fir.ptr<f32>>
+  ! CHECK: fir.save_result %[[VAL_7]] to %[[VAL_6]] : !fir.box<!fir.ptr<f32>>, !fir.ref<!fir.box<!fir.ptr<f32>>>
+  ! CHECK: fir.call @_QPbar_scalar(%[[VAL_6]]) : (!fir.ref<!fir.box<!fir.ptr<f32>>>) -> ()
+    call bar_scalar(get_scalar_pointer())
+  end subroutine
+  
+  ! CHECK-LABEL: test_null
+  subroutine test_null()
+  ! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index
+  ! CHECK: %[[VAL_9:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+  ! CHECK: %[[VAL_10:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x?xf32>>
+  ! CHECK: %[[VAL_11:.*]] = fir.shape %[[VAL_8]], %[[VAL_8]] : (index, index) -> !fir.shape<2>
+  ! CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_10]](%[[VAL_11]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+  ! CHECK: fir.store %[[VAL_12]] to %[[VAL_9]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+  ! CHECK: fir.call @_QPbar(%[[VAL_9]]) : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>) -> ()
+    call bar(null())
+  end subroutine
+  
+  ! CHECK-LABEL: test_null_mold
+  subroutine test_null_mold()
+  ! CHECK: %[[VAL_13:.*]] = arith.constant 0 : index
+  ! CHECK: %[[VAL_14:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+  ! CHECK: %[[VAL_15:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x?xf32>>
+  ! CHECK: %[[VAL_16:.*]] = fir.shape %[[VAL_13]], %[[VAL_13]] : (index, index) -> !fir.shape<2>
+  ! CHECK: %[[VAL_17:.*]] = fir.embox %[[VAL_15]](%[[VAL_16]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+  ! CHECK: fir.store %[[VAL_17]] to %[[VAL_14]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+  ! CHECK: fir.call @_QPbar(%[[VAL_14]]) : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>) -> ()
+    call bar(null(xa))
+  end subroutine
+  
+  ! CHECK-LABEL: test_result
+  subroutine test_result()
+  ! CHECK: %[[VAL_18:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x?xf32>>> {bindc_name = ".result"}
+  ! CHECK: %[[VAL_19:.*]] = fir.call @_QPget_pointer() : () -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+  ! CHECK: fir.save_result %[[VAL_19]] to %[[VAL_18]] : !fir.box<!fir.ptr<!fir.array<?x?xf32>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+  ! CHECK: fir.call @_QPbar(%[[VAL_18]]) : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>) -> ()
+    call bar(get_pointer())
+  end subroutine
+  
+  end module

flang/test/Lower/pointer-runtime.f90

+! RUN: bbc -emit-fir -use-alloc-runtime %s -o - | FileCheck %s
+
+! Test lowering of allocatables using runtime for allocate/deallocate statements.
+! CHECK-LABEL: _QPpointer_runtime(
+subroutine pointer_runtime(n)
+    integer :: n
+    character(:), pointer :: scalar, array(:)
+    ! CHECK-DAG: %[[sBoxAddr:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.char<1,?>>> {{{.*}}uniq_name = "_QFpointer_runtimeEscalar"}
+    ! CHECK-DAG: %[[sNullAddr:.*]] = fir.zero_bits !fir.ptr<!fir.char<1,?>>
+    ! CHECK-DAG: %[[sInitBox:.*]] = fir.embox %[[sNullAddr]] typeparams %c0{{.*}} : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
+    ! CHECK-DAG: fir.store %[[sInitBox]] to %[[sBoxAddr]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+  
+    ! CHECK-DAG: %[[aBoxAddr:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>> {{{.*}}uniq_name = "_QFpointer_runtimeEarray"}
+    ! CHECK-DAG: %[[aNullAddr:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x!fir.char<1,?>>>
+    ! CHECK-DAG: %[[aNullShape:.*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
+    ! CHECK-DAG: %[[aInitBox:.*]] = fir.embox %[[aNullAddr]](%[[aNullShape]]) typeparams %c0{{.*}} : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
+    ! CHECK-DAG: fir.store %[[aInitBox]] to %[[aBoxAddr]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
+  
+    allocate(character(10):: scalar, array(30))
+    ! CHECK-DAG: %[[sBoxCast1:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
+    ! CHECK-DAG: %[[ten1:.*]] = fir.convert %c10{{.*}} : (i32) -> i64
+    ! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[sBoxCast1]], %[[ten1]], %c1{{.*}}, %c0{{.*}}, %c0{{.*}})
+    ! CHECK-NOT: PointerSetBounds
+    ! CHECK: %[[sBoxCast2:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
+    ! CHECK: fir.call @{{.*}}PointerAllocate(%[[sBoxCast2]]
+  
+    ! CHECK-DAG: %[[aBoxCast1:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<none>>
+    ! CHECK-DAG: %[[ten2:.*]] = fir.convert %c10{{.*}} : (i32) -> i64
+    ! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[aBoxCast1]], %[[ten2]], %c1{{.*}}, %c1{{.*}}, %c0{{.*}})
+    ! CHECK: %[[aBoxCast2:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<none>>
+    ! CHECK: fir.call @{{.*}}PointerSetBounds(%[[aBoxCast2]]
+    ! CHECK: %[[aBoxCast3:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<none>>
+    ! CHECK: fir.call @{{.*}}PointerAllocate(%[[aBoxCast3]]
+  
+    deallocate(scalar, array)
+    ! CHECK: %[[sBoxCast3:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
+    ! CHECK: fir.call @{{.*}}PointerDeallocate(%[[sBoxCast3]]
+    ! CHECK: %[[aBoxCast4:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<none>>
+    ! CHECK: fir.call @{{.*}}PointerDeallocate(%[[aBoxCast4]]
+  
+    ! only testing that the correct length is set in the descriptor.
+    allocate(character(n):: scalar, array(40))
+    ! CHECK: %[[n:.*]] = fir.load %arg0 : !fir.ref<i32>
+    ! CHECK-DAG: %[[ncast1:.*]] = fir.convert %[[n]] : (i32) -> i64
+    ! CHECK-DAG: %[[sBoxCast4:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
+    ! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[sBoxCast4]], %[[ncast1]], %c1{{.*}}, %c0{{.*}}, %c0{{.*}})
+    ! CHECK-DAG: %[[ncast2:.*]] = fir.convert %[[n]] : (i32) -> i64
+    ! CHECK-DAG: %[[aBoxCast5:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<none>>
+    ! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[aBoxCast5]], %[[ncast2]], %c1{{.*}}, %c1{{.*}}, %c0{{.*}})
+  end subroutine

flang/test/Lower/pointer.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! TODO: Descriptor (fir.box) will most likely be used for pointers
+! (at least for the character case below). This code is hitting a
+! hard todo until pointers are handled correctly.
+! XFAIL: true
+
+! CHECK-LABEL: func @_QPpointertests
+subroutine pointerTests
+    ! CHECK: fir.global internal @_QFpointertestsEptr1 : !fir.ptr<i32>
+    integer, pointer :: ptr1 => NULL()
+    ! CHECK: %[[c0:.*]] = arith.constant 0 : index
+    ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref<none>
+    ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref<none>) -> !fir.ptr<i32>
+    ! CHECK: fir.has_value [[reg2]] : !fir.ptr<i32>
+  
+    ! CHECK: fir.global internal @_QFpointertestsEptr2 : !fir.ptr<f32>
+    real, pointer :: ptr2 => NULL()
+    ! CHECK: %[[c0:.*]] = arith.constant 0 : index
+    ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref<none>
+    ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref<none>) -> !fir.ptr<f32>
+    ! CHECK: fir.has_value [[reg2]] : !fir.ptr<f32>
+  
+    ! CHECK: fir.global internal @_QFpointertestsEptr3 : !fir.ptr<!fir.complex<4>>
+    complex, pointer :: ptr3 => NULL()
+    ! CHECK: %[[c0:.*]] = arith.constant 0 : index
+    ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref<none>
+    ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref<none>) -> !fir.ptr<!fir.complex<4>>
+    ! CHECK: fir.has_value [[reg2]] : !fir.ptr<!fir.complex<4>>
+  
+    ! CHECK: fir.global internal @_QFpointertestsEptr4 : !fir.ptr<!fir.char<1,?>>
+    character(:), pointer :: ptr4 => NULL()
+    ! CHECK: %[[c0:.*]] = arith.constant 0 : index
+    ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref<none>
+    ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref<none>) -> !fir.ptr<!fir.char<1,?>>
+    ! CHECK: fir.has_value [[reg2]] : !fir.ptr<!fir.char<1,?>>
+  
+    ! CHECK: fir.global internal @_QFpointertestsEptr5 : !fir.ptr<!fir.logical<4>>
+    logical, pointer :: ptr5 => NULL()
+    ! CHECK: %[[c0:.*]] = arith.constant 0 : index
+    ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref<none>
+    ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref<none>) -> !fir.ptr<!fir.logical<4>>
+    ! CHECK: fir.has_value [[reg2]] : !fir.ptr<!fir.logical<4>>
+  
+  end subroutine pointerTests