[flang][hlfir] Enable lowering and passing of allocatables and pointers.

[jeanPerier]

Summary

Adds support for:

• referencing a whole allocatable/pointer symbol
• passing allocatable/pointer in a call

This required update in HLFIRTools.cpp helpers so that the
raw address, extents, lower bounds, and type parameters of a
fir.box/fir.class can be extracted.
This is required because in hlfir lowering, dereferencing a
pointer/alloc is only doing the fir.load fir.box part, and the
helpers have to be able to reason about that fir.box without the
help of a "fir::FortranVariableOpInterface".

Missing:

• referencing part of allocatable/pointer (will need to update Designator lowering to dereference the pointer/alloc). Same for whole allocatable and pointer components.
• allocate/deallocate/pointer assignment statements.
• Whole allocatable assignment.
• Lower inquires.

[PeteSteinfeld]

Aside from some nits and questions, all builds and tests correctly and looks good.

flang/include/flang/Optimizer/Builder/HLFIRTools.h

137

"know" should be "known"

flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td

125

"has" should be "have"

flang/lib/Optimizer/Builder/HLFIRTools.cpp

74–78

This interface seems a little off to me. In the name "Extents" is plural, while "Lbound" is singular. Also, in every call, the "lbounds" argument is non-null, but the code allows for it to be null. Would it be better to assert that it's non-null?

418

Is "boxes" supposed to be "boxed"?

697

"avoid" should be "avoids".

[jeanPerier]

flang/lib/Optimizer/Builder/HLFIRTools.cpp

74–78

Good points, I renamed it to genLboundsAndExtentsFromBox (so that the name reflects the argument order), and I made the first argument a reference.

418

Yes, thanks

[jeanPerier]

Thanks for the review Pete, I addressed your comments.

flang/include/flang/Lower/Allocatable.h

 
 void genDeallocateBox(AbstractConverter &converter,
                       const fir::MutableBoxValue &box, mlir::Location loc,
                       mlir::Value declaredTypeDesc = {});
 
 /// Create a MutableBoxValue for an allocatable or pointer entity.
 /// If the variables is a local variable that is not a dummy, it will be
 /// initialized to unallocated/diassociated status.
-fir::MutableBoxValue createMutableBox(AbstractConverter &converter,
-                                      mlir::Location loc,
-                                      const pft::Variable &var,
-                                      mlir::Value boxAddr,
-                                      mlir::ValueRange nonDeferredParams);
+fir::MutableBoxValue
+createMutableBox(AbstractConverter &converter, mlir::Location loc,
+                 const pft::Variable &var, mlir::Value boxAddr,
+                 mlir::ValueRange nonDeferredParams, bool alwaysUseBox);
 
 /// Assign a boxed value to a boxed variable, \p box (known as a
 /// MutableBoxValue). Expression \p source will be lowered to build the
 /// assignment. If \p lbounds is not empty, it is used to define the result's
 /// lower bounds. Otherwise, the lower bounds from \p source will be used.
 void associateMutableBox(AbstractConverter &converter, mlir::Location loc,
                          const fir::MutableBoxValue &box,
                          const SomeExpr &source, mlir::ValueRange lbounds,

flang/include/flang/Optimizer/Builder/HLFIRTools.h

public:
   Entity(fir::FortranVariableOpInterface variable)
       : mlir::Value(variable.getBase()) {}
   bool isValue() const { return isFortranValue(*this); }
   bool isVariable() const { return !isValue(); }
   bool isMutableBox() const { return hlfir::isBoxAddressType(getType()); }
   bool isBoxAddressOrValue() const {
     return hlfir::isBoxAddressOrValueType(getType());
   }
-  bool isArray() const {
+  /// Is this an array or an assumed ranked entity?
+  bool isArray() const { return getRank() != 0; }
+
+  /// Return the rank of this entity or -1 if it is an assumed rank.
+  int getRank() const {
     mlir::Type type = fir::unwrapPassByRefType(fir::unwrapRefType(getType()));
-    if (type.isa<fir::SequenceType>())
-      return true;
+    if (auto seqTy = type.dyn_cast<fir::SequenceType>()) {
+      if (seqTy.hasUnknownShape())
+        return -1;
+      return seqTy.getDimension();
+    }
     if (auto exprType = type.dyn_cast<hlfir::ExprType>())
-      return exprType.isArray();
-    return false;
+      return exprType.getRank();
+    return 0;
   }
   bool isScalar() const { return !isArray(); }
 
   bool isPolymorphic() const {
     if (auto exprType = getType().dyn_cast<hlfir::ExprType>())
       return exprType.isPolymorphic();
     return fir::isPolymorphicType(getType());
   }
 
   mlir::Type getFortranElementType() const {
     return hlfir::getFortranElementType(getType());
   }
 
   bool hasLengthParameters() const {
     mlir::Type eleTy = getFortranElementType();
     return eleTy.isa<fir::CharacterType>() ||
            fir::isRecordWithTypeParameters(eleTy);
   }
 
   bool isCharacter() const {
     return getFortranElementType().isa<fir::CharacterType>();
   }
 
+  bool isDerivedWithLengthParameters() const {
+    return fir::isRecordWithTypeParameters(getFortranElementType());
+  }
+
   bool hasNonDefaultLowerBounds() const {
     if (!isBoxAddressOrValue() || isScalar())
       return false;
     if (isMutableBox())
       return true;
     if (auto varIface = getIfVariableInterface()) {
       if (auto shape = varIface.getShape()) {
         auto shapeTy = shape.getType();
         return shapeTy.isa<fir::ShiftType>() ||
                shapeTy.isa<fir::ShapeShiftType>();
       }
       return false;
     }
     return true;
   }
 
+  // Is this entity known to be contiguous at compile time?
+  // Note that when this returns false, the entity may still
+  // turn-out to be contiguous at runtime.
+  bool isSimplyContiguous() const {
+    // If this can be described without a fir.box in FIR, this must
+    // be contiguous.
+    if (!hlfir::isBoxAddressOrValueType(getFirBase().getType()))
+      return true;
+    // Otherwise, if this entity has a visible declaration in FIR,
+    // or is the dereference of an allocatable or contiguous pointer
+    // it is simply contiguous.
+    if (auto varIface = getMaybeDereferencedVariableInterface())
+      return varIface.isAllocatable() || varIface.hasContiguousAttr();
+    return false;
+  }
+
   fir::FortranVariableOpInterface getIfVariableInterface() const {
     return this->getDefiningOp<fir::FortranVariableOpInterface>();
   }
 
+  // Return a "declaration" operation for this variable if visible,
+  // or the "declaration" operation of the allocatable/pointer this
+  // variable was dereferenced from (if it is visible).
+  fir::FortranVariableOpInterface
+  getMaybeDereferencedVariableInterface() const {
+    mlir::Value base = *this;
+    if (auto loadOp = base.getDefiningOp<fir::LoadOp>())
+      base = loadOp.getMemref();
+    return base.getDefiningOp<fir::FortranVariableOpInterface>();
+  }
+
   // Get the entity as an mlir SSA value containing all the shape, type
   // parameters and dynamic shape information.
   mlir::Value getBase() const { return *this; }
 
   // Get the entity as a FIR base. This may not carry the shape and type
   // parameters information, and even when it is a box with shape information.
   // it will not contain the local lower bounds of the entity. This should
   // be used with care when generating FIR code that does not need this

flang/include/flang/Optimizer/Dialect/FIROps.td

let description = [{
     ```
   }];
 
   let arguments = (ins AnyBoxLike:$val);
 
   let results = (outs AnyCodeOrDataRefLike);
 
   let hasFolder = 1;
+
+  let builders = [OpBuilder<(ins "mlir::Value":$val)>];
 }
 
 def fir_BoxCharLenOp : fir_SimpleOp<"boxchar_len", [NoMemoryEffect]> {
   let summary = "return the LEN type parameter from a boxchar value";
 
   let description = [{
     Extracts the LEN type parameter from a `boxchar` value.
 

flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td

let extraClassDeclaration = [{
 
     /// Is this variable a Fortran optional?
     bool isOptional() {
       auto attrs = getFortranAttrs();
       return attrs && bitEnumContainsAny(*attrs,
                         fir::FortranVariableFlagsEnum::optional);
     }
 
+    /// Does this variable have the Fortran CONTIGUOUS attribute?
+    /// Note that not having this attribute does not imply the
+    /// variable is not contiguous.
+    bool hasContiguousAttr() {
+      auto attrs = getFortranAttrs();
+      return attrs && bitEnumContainsAny(*attrs,
+                        fir::FortranVariableFlagsEnum::contiguous);
+    }
+
     /// Is this a Fortran character variable?
     bool isCharacter() {
       return getElementType().isa<fir::CharacterType>();
     }
 
     /// Is this a Fortran character variable with an explicit length?
     bool hasExplicitCharLen() {
       return isCharacter() && !getExplicitTypeParams().empty();

flang/lib/Lower/Allocatable.cpp

 
 /// In case it is safe to track the properties in variables outside a
 /// descriptor, create the variables to hold the mutable properties of the
 /// entity var. The variables are not initialized here.
 static fir::MutableProperties
 createMutableProperties(Fortran::lower::AbstractConverter &converter,
                         mlir::Location loc,
                         const Fortran::lower::pft::Variable &var,
-                        mlir::ValueRange nonDeferredParams) {
+                        mlir::ValueRange nonDeferredParams, bool alwaysUseBox) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   const Fortran::semantics::Symbol &sym = var.getSymbol();
   // Globals and dummies may be associated, creating local variables would
   // require keeping the values and descriptor before and after every single
   // impure calls in the current scope (not only the ones taking the variable as
   // arguments. All.) Volatile means the variable may change in ways not defined
   // per Fortran, so lowering can most likely not keep the descriptor and values
   // in sync as needed.
   // Pointers to non contiguous arrays need to be represented with a fir.box to
   // account for the discontiguity.
   // Pointer/Allocatable in internal procedure are descriptors in the host link,
   // and it would increase complexity to sync this descriptor with the local
   // values every time the host link is escaping.
-  if (var.isGlobal() || Fortran::semantics::IsDummy(sym) ||
+  if (alwaysUseBox || var.isGlobal() || Fortran::semantics::IsDummy(sym) ||
       Fortran::semantics::IsFunctionResult(sym) ||
       sym.attrs().test(Fortran::semantics::Attr::VOLATILE) ||
       isNonContiguousArrayPointer(sym) || useAllocateRuntime ||
       useDescForMutableBox || mayBeCapturedInInternalProc(sym) ||
       isPolymorphicPointer(sym) || isPolymorphicAllocatable(sym))
     return {};
   fir::MutableProperties mutableProperties;
   std::string name = converter.mangleName(sym);
if (fir::isa_char(eleTy) && nonDeferredParams.empty()) {
     mutableProperties.deferredParams.emplace_back(lenVar);
   }
   return mutableProperties;
 }
 
 fir::MutableBoxValue Fortran::lower::createMutableBox(
     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
     const Fortran::lower::pft::Variable &var, mlir::Value boxAddr,
-    mlir::ValueRange nonDeferredParams) {
+    mlir::ValueRange nonDeferredParams, bool alwaysUseBox) {
 
-  fir::MutableProperties mutableProperties =
-      createMutableProperties(converter, loc, var, nonDeferredParams);
+  fir::MutableProperties mutableProperties = createMutableProperties(
+      converter, loc, var, nonDeferredParams, alwaysUseBox);
   fir::MutableBoxValue box(boxAddr, nonDeferredParams, mutableProperties);
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   if (!var.isGlobal() && !Fortran::semantics::IsDummy(var.getSymbol()))
     fir::factory::disassociateMutableBox(builder, loc, box,
                                          /*polymorphicSetType=*/false);
   return box;
 }
 

flang/lib/Lower/ConvertCall.cpp

case PassBy::AddressAndLength:
       break;
     case PassBy::CharProcTuple: {
       TODO(loc, "HLFIR PassBy::CharProcTuple");
     } break;
     case PassBy::Box: {
       TODO(loc, "HLFIR PassBy::Box");
     } break;
     case PassBy::MutableBox: {
-      TODO(loc, "HLFIR PassBy::MutableBox");
+      if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+              *expr)) {
+        // If expr is NULL(), the mutableBox created must be a deallocated
+        // pointer with the dummy argument characteristics (see table 16.5
+        // in Fortran 2018 standard).
+        // No length parameters are set for the created box because any non
+        // deferred type parameters of the dummy will be evaluated on the
+        // callee side, and it is illegal to use NULL without a MOLD if any
+        // dummy length parameters are assumed.
+        mlir::Type boxTy = fir::dyn_cast_ptrEleTy(argTy);
+        assert(boxTy && boxTy.isa<fir::BoxType>() && "must be a fir.box type");
+        mlir::Value boxStorage = builder.createTemporary(loc, boxTy);
+        mlir::Value nullBox = fir::factory::createUnallocatedBox(
+            builder, loc, boxTy, /*nonDeferredParams=*/{});
+        builder.create<fir::StoreOp>(loc, nullBox, boxStorage);
+        caller.placeInput(arg, boxStorage);
+        continue;
+      }
+      if (fir::isPointerType(argTy) &&
+          !Fortran::evaluate::IsObjectPointer(
+              *expr, callContext.converter.getFoldingContext())) {
+        // Passing a non POINTER actual argument to a POINTER dummy argument.
+        // Create a pointer of the dummy argument type and assign the actual
+        // argument to it.
+        TODO(loc, "Associate POINTER dummy to TARGET argument in HLFIR");
+        continue;
+      }
+      // Passing a POINTER to a POINTER, or an ALLOCATABLE to an ALLOCATABLE.
+      assert(actual.isMutableBox() && "actual must be a mutable box");
+      caller.placeInput(arg, actual);
+      if (fir::isAllocatableType(argTy) && arg.isIntentOut() &&
+          Fortran::semantics::IsBindCProcedure(
+              *callContext.procRef.proc().GetSymbol())) {
+        TODO(loc, "BIND(C) INTENT(OUT) allocatable deallocation in HLFIR");
+      }
     } break;
     }
   }
   // Prepare lowered arguments according to the interface
   // and map the lowered values to the dummy
   // arguments.
   fir::ExtendedValue result = Fortran::lower::genCallOpAndResult(
       loc, callContext.converter, callContext.symMap, callContext.stmtCtx,

flang/lib/Lower/ConvertVariable.cpp

 
 /// Map an allocatable or pointer symbol to its FIR address and evaluated
 /// specification expressions. Will optionally create fir.declare.
 static void
 genAllocatableOrPointerDeclare(Fortran::lower::AbstractConverter &converter,
                                Fortran::lower::SymMap &symMap,
                                const Fortran::semantics::Symbol &sym,
                                fir::MutableBoxValue box, bool force = false) {
-  if (converter.getLoweringOptions().getLowerToHighLevelFIR())
-    TODO(genLocation(converter, sym),
-         "generate fir.declare for allocatable or pointers");
+  if (!converter.getLoweringOptions().getLowerToHighLevelFIR()) {
     symMap.addAllocatableOrPointer(sym, box, force);
+    return;
+  }
+  assert(!box.isDescribedByVariables() &&
+         "HLFIR alloctables/pointers must be fir.ref<fir.box>");
+  mlir::Value base = box.getAddr();
+  mlir::Value explictLength;
+  if (box.hasNonDeferredLenParams()) {
+    if (!box.isCharacter())
+      TODO(genLocation(converter, sym),
+           "Pointer or Allocatable parametrized derived type");
+    explictLength = box.nonDeferredLenParams()[0];
+  }
+  genDeclareSymbol(converter, symMap, sym, base, explictLength,
+                   /*shape=*/std::nullopt,
+                   /*lbounds=*/std::nullopt, force);
 }
 
 /// Map a symbol represented with a runtime descriptor to its FIR fir.box and
 /// evaluated specification expressions. Will optionally create fir.declare.
 static void genBoxDeclare(Fortran::lower::AbstractConverter &converter,
                           Fortran::lower::SymMap &symMap,
                           const Fortran::semantics::Symbol &sym,
                           mlir::Value box, llvm::ArrayRef<mlir::Value> lbounds,
if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
     } else if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType()) {
       if (const Fortran::semantics::DerivedTypeSpec *derived =
               declTy->AsDerived())
         if (Fortran::semantics::CountLenParameters(*derived) != 0)
           TODO(loc,
                "derived type allocatable or pointer with length parameters");
     }
     fir::MutableBoxValue box = Fortran::lower::createMutableBox(
-        converter, loc, var, boxAlloc, nonDeferredLenParams);
+        converter, loc, var, boxAlloc, nonDeferredLenParams,
+        /*alwaysUseBox=*/
+        converter.getLoweringOptions().getLowerToHighLevelFIR());
     genAllocatableOrPointerDeclare(converter, symMap, var.getSymbol(), box,
                                    replace);
     return;
   }
 
   if (isDummy) {
     mlir::Value dummyArg = symMap.lookupSymbol(sym).getAddr();
     if (lowerToBoxValue(sym, dummyArg)) {

flang/lib/Optimizer/Builder/HLFIRTools.cpp

 //===-- HLFIRTools.cpp ----------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // Tools to manipulate HLFIR variable and expressions
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/Builder/HLFIRTools.h"
+#include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/MutableBox.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/HLFIR/HLFIROps.h"
 #include "mlir/IR/IRMapping.h"
 #include <optional>
 
 // Return explicit extents. If the base is a fir.box, this won't read it to
 // return the extents and will instead return an empty vector.
-static llvm::SmallVector<mlir::Value> getExplicitExtents(mlir::Value shape) {
+static llvm::SmallVector<mlir::Value>
+getExplicitExtentsFromShape(mlir::Value shape) {
   llvm::SmallVector<mlir::Value> result;
   auto *shapeOp = shape.getDefiningOp();
   if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {
     auto e = s.getExtents();
     result.append(e.begin(), e.end());
   } else if (auto s = mlir::dyn_cast_or_null<fir::ShapeShiftOp>(shapeOp)) {
     auto e = s.getExtents();
     result.append(e.begin(), e.end());
   } else if (mlir::dyn_cast_or_null<fir::ShiftOp>(shapeOp)) {
     return {};
   } else {
     TODO(shape.getLoc(), "read fir.shape to get extents");
   }
   return result;
 }
 static llvm::SmallVector<mlir::Value>
 getExplicitExtents(fir::FortranVariableOpInterface var) {
   if (mlir::Value shape = var.getShape())
-    return getExplicitExtents(var.getShape());
+    return getExplicitExtentsFromShape(var.getShape());
   return {};
 }
 
 // Return explicit lower bounds. For pointers and allocatables, this will not
 // read the lower bounds and instead return an empty vector.
-static llvm::SmallVector<mlir::Value> getExplicitLbounds(mlir::Value shape) {
+static llvm::SmallVector<mlir::Value>
+getExplicitLboundsFromShape(mlir::Value shape) {
   llvm::SmallVector<mlir::Value> result;
   auto *shapeOp = shape.getDefiningOp();
   if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {
     return {};
   } else if (auto s = mlir::dyn_cast_or_null<fir::ShapeShiftOp>(shapeOp)) {
     auto e = s.getOrigins();
     result.append(e.begin(), e.end());
   } else if (auto s = mlir::dyn_cast_or_null<fir::ShiftOp>(shapeOp)) {
     auto e = s.getOrigins();
     result.append(e.begin(), e.end());
   } else {
     TODO(shape.getLoc(), "read fir.shape to get lower bounds");
   }
   return result;
 }
 static llvm::SmallVector<mlir::Value>
 getExplicitLbounds(fir::FortranVariableOpInterface var) {
   if (mlir::Value shape = var.getShape())
-    return getExplicitLbounds(shape);
+    return getExplicitLboundsFromShape(shape);
   return {};
 }
 
+static void
+genLboundsAndExtentsFromBox(mlir::Location loc, fir::FirOpBuilder &builder,
+                            hlfir::Entity boxEntity,
+                            llvm::SmallVectorImpl<mlir::Value> &lbounds,
+                            llvm::SmallVectorImpl<mlir::Value> *extents) {
+  assert(boxEntity.getType().isa<fir::BaseBoxType>() && "must be a box");
+  mlir::Type idxTy = builder.getIndexType();
+  const int rank = boxEntity.getRank();
+  for (int i = 0; i < rank; ++i) {
+    mlir::Value dim = builder.createIntegerConstant(loc, idxTy, i);
+    auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
+                                                  boxEntity, dim);
+    lbounds.push_back(dimInfo.getLowerBound());
+    if (extents)
+      extents->push_back(dimInfo.getExtent());
+  }
+}
+
 static llvm::SmallVector<mlir::Value>
-getExplicitTypeParams(fir::FortranVariableOpInterface var) {
+getNonDefaultLowerBounds(mlir::Location loc, fir::FirOpBuilder &builder,
+                         hlfir::Entity entity) {
+  if (!entity.hasNonDefaultLowerBounds())
+    return {};
+  if (auto varIface = entity.getIfVariableInterface()) {
+    llvm::SmallVector<mlir::Value> lbounds = getExplicitLbounds(varIface);
+    if (!lbounds.empty())
+      return lbounds;
+  }
+  if (entity.isMutableBox())
+    entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
+  llvm::SmallVector<mlir::Value> lowerBounds;
+  genLboundsAndExtentsFromBox(loc, builder, entity, lowerBounds,
+                              /*extents=*/nullptr);
+  return lowerBounds;
+}
+
+static llvm::SmallVector<mlir::Value> toSmallVector(mlir::ValueRange range) {
   llvm::SmallVector<mlir::Value> res;
-  mlir::OperandRange range = var.getExplicitTypeParams();
   res.append(range.begin(), range.end());
   return res;
 }
 
-std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
-hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
-                                hlfir::Entity entity) {
-  if (auto variable = entity.getIfVariableInterface())
-    return {hlfir::translateToExtendedValue(loc, builder, variable), {}};
-  if (entity.isVariable()) {
-    if (entity.isScalar() && !entity.hasLengthParameters() &&
-        !hlfir::isBoxAddressOrValueType(entity.getType()))
-      return {fir::ExtendedValue{entity.getBase()}, std::nullopt};
-    TODO(loc, "HLFIR variable to fir::ExtendedValue without a "
-              "FortranVariableOpInterface");
-  }
-  if (entity.getType().isa<hlfir::ExprType>()) {
-    hlfir::AssociateOp associate = hlfir::genAssociateExpr(
-        loc, builder, entity, entity.getType(), "adapt.valuebyref");
-    auto *bldr = &builder;
-    hlfir::CleanupFunction cleanup = [bldr, loc, associate]() -> void {
-      bldr->create<hlfir::EndAssociateOp>(loc, associate);
-    };
-    hlfir::Entity temp{associate.getBase()};
-    return {translateToExtendedValue(loc, builder, temp).first, cleanup};
-  }
-  return {{static_cast<mlir::Value>(entity)}, {}};
+static llvm::SmallVector<mlir::Value> getExplicitTypeParams(hlfir::Entity var) {
+  if (auto varIface = var.getMaybeDereferencedVariableInterface())
+    return toSmallVector(varIface.getExplicitTypeParams());
+  return {};
+
+static mlir::Value tryGettingNonDeferredCharLen(hlfir::Entity var) {
+  if (auto varIface = var.getMaybeDereferencedVariableInterface())
+    if (!varIface.getExplicitTypeParams().empty())
+      return varIface.getExplicitTypeParams()[0];
+  return mlir::Value{};
+
+static mlir::Value genCharacterVariableLength(mlir::Location loc,
+                                              fir::FirOpBuilder &builder,
+                                              hlfir::Entity var) {
+  if (mlir::Value len = tryGettingNonDeferredCharLen(var))
+    return len;
+  auto charType = var.getFortranElementType().cast<fir::CharacterType>();
+  if (charType.hasConstantLen())
+    return builder.createIntegerConstant(loc, builder.getIndexType(),
+                                         charType.getLen());
+  if (var.isMutableBox())
+    var = hlfir::Entity{builder.create<fir::LoadOp>(loc, var)};
+  mlir::Value len = fir::factory::CharacterExprHelper{builder, loc}.getLength(
+      var.getFirBase());
+  assert(len && "failed to retrieve length");
+  return len;
+}
+
+static fir::CharBoxValue genUnboxChar(mlir::Location loc,
+                                      fir::FirOpBuilder &builder,
+                                      mlir::Value boxChar) {
+  if (auto emboxChar = boxChar.getDefiningOp<fir::EmboxCharOp>())
+    return {emboxChar.getMemref(), emboxChar.getLen()};
+  mlir::Type refType = fir::ReferenceType::get(
+      boxChar.getType().cast<fir::BoxCharType>().getEleTy());
+  auto unboxed = builder.create<fir::UnboxCharOp>(
+      loc, refType, builder.getIndexType(), boxChar);
+  mlir::Value addr = unboxed.getResult(0);
+  mlir::Value len = unboxed.getResult(1);
+  if (auto varIface = boxChar.getDefiningOp<fir::FortranVariableOpInterface>())
+    if (mlir::Value explicitlen = varIface.getExplicitCharLen())
+      len = explicitlen;
+  return {addr, len};
 }
 
 mlir::Value hlfir::Entity::getFirBase() const {
   if (fir::FortranVariableOpInterface variable = getIfVariableInterface()) {
     if (auto declareOp =
             mlir::dyn_cast<hlfir::DeclareOp>(variable.getOperation()))
       return declareOp.getOriginalBase();
     if (auto associateOp =
             mlir::dyn_cast<hlfir::AssociateOp>(variable.getOperation()))
       return associateOp.getFirBase();
   }
   return getBase();
 }
 
-fir::ExtendedValue
-hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
-                                fir::FortranVariableOpInterface variable) {
-  /// When going towards FIR, use the original base value to avoid
-  /// introducing descriptors at runtime when they are not required.
-  mlir::Value firBase = Entity{variable}.getFirBase();
-  if (variable.isPointer() || variable.isAllocatable())
-    TODO(variable->getLoc(), "pointer or allocatable "
-                             "FortranVariableOpInterface to extendedValue");
-  if (firBase.getType().isa<fir::BaseBoxType>())
-    return fir::BoxValue(firBase, getExplicitLbounds(variable),
-                         getExplicitTypeParams(variable));
-
-  if (variable.isCharacter()) {
-    if (variable.isArray())
-      return fir::CharArrayBoxValue(firBase, variable.getExplicitCharLen(),
-                                    getExplicitExtents(variable),
-                                    getExplicitLbounds(variable));
-    if (auto boxCharType = firBase.getType().dyn_cast<fir::BoxCharType>()) {
-      auto unboxed = builder.create<fir::UnboxCharOp>(
-          loc, fir::ReferenceType::get(boxCharType.getEleTy()),
-          builder.getIndexType(), firBase);
-      return fir::CharBoxValue(unboxed.getResult(0),
-                               variable.getExplicitCharLen());
-    }
-    return fir::CharBoxValue(firBase, variable.getExplicitCharLen());
-  }
-  if (variable.isArray())
-    return fir::ArrayBoxValue(firBase, getExplicitExtents(variable),
-                              getExplicitLbounds(variable));
-  return firBase;
-}
-
 fir::FortranVariableOpInterface
 hlfir::genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
                   const fir::ExtendedValue &exv, llvm::StringRef name,
                   fir::FortranVariableFlagsAttr flags) {
 
   mlir::Value base = fir::getBase(exv);
   assert(fir::conformsWithPassByRef(base.getType()) &&
          "entity being declared must be in memory");

 mlir::Value hlfir::genVariableRawAddress(mlir::Location loc,
                                          fir::FirOpBuilder &builder,
                                          hlfir::Entity var) {
   assert(var.isVariable() && "only address of variables can be taken");
   mlir::Value baseAddr = var.getFirBase();
   if (var.isMutableBox())
     baseAddr = builder.create<fir::LoadOp>(loc, baseAddr);
   // Get raw address.
-  if (baseAddr.getType().isa<fir::BaseBoxType>()) {
-    auto addrType =
-        fir::ReferenceType::get(fir::unwrapPassByRefType(baseAddr.getType()));
-    baseAddr = builder.create<fir::BoxAddrOp>(loc, addrType, baseAddr);
-  }
+  if (baseAddr.getType().isa<fir::BaseBoxType>())
+    baseAddr = builder.create<fir::BoxAddrOp>(loc, baseAddr);
   return baseAddr;
 }
 
 mlir::Value hlfir::genVariableBoxChar(mlir::Location loc,
                                       fir::FirOpBuilder &builder,
                                       hlfir::Entity var) {
   assert(var.isVariable() && "only address of variables can be taken");
   if (var.getType().isa<fir::BoxCharType>())
hlfir::Entity hlfir::loadTrivialScalar(mlir::Location loc,
   entity = derefPointersAndAllocatables(loc, builder, entity);
   if (entity.isVariable() && entity.isScalar() &&
       fir::isa_trivial(entity.getFortranElementType())) {
     return Entity{builder.create<fir::LoadOp>(loc, entity)};
   }
   return entity;
 }
 
-static std::optional<llvm::SmallVector<mlir::Value>>
-getNonDefaultLowerBounds(mlir::Location loc, fir::FirOpBuilder &builder,
-                         hlfir::Entity entity) {
-  if (!entity.hasNonDefaultLowerBounds())
-    return std::nullopt;
-  if (auto varIface = entity.getIfVariableInterface()) {
-    llvm::SmallVector<mlir::Value> lbounds = getExplicitLbounds(varIface);
-    if (!lbounds.empty())
-      return lbounds;
-  }
-  TODO(loc, "get non default lower bounds without FortranVariableInterface");
-}
-
 hlfir::Entity hlfir::getElementAt(mlir::Location loc,
                                   fir::FirOpBuilder &builder, Entity entity,
                                   mlir::ValueRange oneBasedIndices) {
   if (entity.isScalar())
     return entity;
   llvm::SmallVector<mlir::Value> lenParams;
   genLengthParameters(loc, builder, entity, lenParams);
   if (entity.getType().isa<hlfir::ExprType>())
     return hlfir::Entity{builder.create<hlfir::ApplyOp>(
         loc, entity, oneBasedIndices, lenParams)};
   // Build hlfir.designate. The lower bounds may need to be added to
   // the oneBasedIndices since hlfir.designate expect indices
   // based on the array operand lower bounds.
   mlir::Type resultType = hlfir::getVariableElementType(entity);
   hlfir::DesignateOp designate;
-  if (auto lbounds = getNonDefaultLowerBounds(loc, builder, entity)) {
+  llvm::SmallVector<mlir::Value> lbounds =
+      getNonDefaultLowerBounds(loc, builder, entity);
+  if (!lbounds.empty()) {
     llvm::SmallVector<mlir::Value> indices;
     mlir::Type idxTy = builder.getIndexType();
     mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
-    for (auto [oneBased, lb] : llvm::zip(oneBasedIndices, *lbounds)) {
+    for (auto [oneBased, lb] : llvm::zip(oneBasedIndices, lbounds)) {
       auto lbIdx = builder.createConvert(loc, idxTy, lb);
       auto oneBasedIdx = builder.createConvert(loc, idxTy, oneBased);
       auto shift = builder.create<mlir::arith::SubIOp>(loc, lbIdx, one);
       mlir::Value index =
           builder.create<mlir::arith::AddIOp>(loc, oneBasedIdx, shift);
       indices.push_back(index);
     }
     designate = builder.create<hlfir::DesignateOp>(loc, resultType, entity,

 }
 
 llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>
 hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder,
                  mlir::Value shape) {
   assert((shape.getType().isa<fir::ShapeShiftType>() ||
           shape.getType().isa<fir::ShapeType>()) &&
          "shape must contain extents");
-  auto extents = getExplicitExtents(shape);
-  auto lowers = getExplicitLbounds(shape);
+  auto extents = getExplicitExtentsFromShape(shape);
+  auto lowers = getExplicitLboundsFromShape(shape);
   assert(lowers.empty() || lowers.size() == extents.size());
   mlir::Type idxTy = builder.getIndexType();
   mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
   llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> result;
   for (auto extent : llvm::enumerate(extents)) {
     mlir::Value lb = lowers.empty() ? one : lowers[extent.index()];
     mlir::Value ub = lowers.empty()
                          ? extent.value()
if (auto asExpr = entity.getDefiningOp<hlfir::AsExprOp>()) {
       entity = hlfir::Entity{asExpr.getVar()};
       continue;
     }
     break;
   }
   return entity;
 }
 
+llvm::SmallVector<mlir::Value> getVariableExtents(mlir::Location loc,
+                                                  fir::FirOpBuilder &builder,
+                                                  hlfir::Entity variable) {
+  llvm::SmallVector<mlir::Value> extents;
+  if (fir::FortranVariableOpInterface varIface =
+          variable.getIfVariableInterface()) {
+    extents = getExplicitExtents(varIface);
+    if (!extents.empty())
+      return extents;
+  }
+
+  if (variable.isMutableBox())
+    variable = hlfir::derefPointersAndAllocatables(loc, builder, variable);
+  // Use the type shape information, and/or the fir.box/fir.class shape
+  // information if any extents are not static.
+  fir::SequenceType seqTy =
+      hlfir::getFortranElementOrSequenceType(variable.getType())
+          .cast<fir::SequenceType>();
+  mlir::Type idxTy = builder.getIndexType();
+  for (auto typeExtent : seqTy.getShape())
+    if (typeExtent != fir::SequenceType::getUnknownExtent()) {
+      extents.push_back(builder.createIntegerConstant(loc, idxTy, typeExtent));
+    } else {
+      assert(variable.getType().isa<fir::BaseBoxType>() &&
+             "array variable with dynamic extent must be boxed");
+      mlir::Value dim =
+          builder.createIntegerConstant(loc, idxTy, extents.size());
+      auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
+                                                    variable, dim);
+      extents.push_back(dimInfo.getExtent());
+    }
+  return extents;
+}
+
 mlir::Value hlfir::genShape(mlir::Location loc, fir::FirOpBuilder &builder,
                             hlfir::Entity entity) {
   assert(entity.isArray() && "entity must be an array");
-  if (entity.isMutableBox())
-    entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
-  else
-    entity = followEntitySource(entity);
 
   if (entity.getType().isa<hlfir::ExprType>()) {
     if (auto elemental = entity.getDefiningOp<hlfir::ElementalOp>())
       return elemental.getShape();
     TODO(loc, "get shape from HLFIR expr without producer holding the shape");
   }
   // Entity is an array variable.
   if (auto varIface = entity.getIfVariableInterface()) {
     if (auto shape = varIface.getShape()) {
       if (shape.getType().isa<fir::ShapeType>())
         return shape;
       if (shape.getType().isa<fir::ShapeShiftType>())
         if (auto s = shape.getDefiningOp<fir::ShapeShiftOp>())
           return builder.create<fir::ShapeOp>(loc, s.getExtents());
     }
   }
-  // There is no shape lying around for this entity: build one using
-  // the type shape information, and/or the fir.box/fir.class shape
-  // information if any extents are not static.
-  fir::SequenceType seqTy =
-      hlfir::getFortranElementOrSequenceType(entity.getType())
-          .cast<fir::SequenceType>();
-  llvm::SmallVector<mlir::Value> extents;
-  mlir::Type idxTy = builder.getIndexType();
-  for (auto typeExtent : seqTy.getShape())
-    if (typeExtent != fir::SequenceType::getUnknownExtent()) {
-      extents.push_back(builder.createIntegerConstant(loc, idxTy, typeExtent));
-    } else {
-      assert(entity.getType().isa<fir::BaseBoxType>() &&
-             "array variable with dynamic extent must be boxes");
-      mlir::Value dim =
-          builder.createIntegerConstant(loc, idxTy, extents.size());
-      auto dimInfo =
-          builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, entity, dim);
-      extents.push_back(dimInfo.getExtent());
-    }
-  return builder.create<fir::ShapeOp>(loc, extents);
+  // There is no shape lying around for this entity. Retrieve the extents and
+  // build a new fir.shape.
+  return builder.create<fir::ShapeOp>(loc,
+                                      getVariableExtents(loc, builder, entity));
 }
 
 llvm::SmallVector<mlir::Value>
 hlfir::getIndexExtents(mlir::Location loc, fir::FirOpBuilder &builder,
                        mlir::Value shape) {
-  llvm::SmallVector<mlir::Value> extents;
-  if (auto s = shape.getDefiningOp<fir::ShapeOp>()) {
-    auto e = s.getExtents();
-    extents.insert(extents.end(), e.begin(), e.end());
-  } else if (auto s = shape.getDefiningOp<fir::ShapeShiftOp>()) {
-    auto e = s.getExtents();
-    extents.insert(extents.end(), e.begin(), e.end());
-  } else {
-    // TODO: add fir.get_extent ops on fir.shape<> ops.
-    TODO(loc, "get extents from fir.shape without fir::ShapeOp parent op");
-  }
+  llvm::SmallVector<mlir::Value> extents = getExplicitExtentsFromShape(shape);
   mlir::Type indexType = builder.getIndexType();
   for (auto &extent : extents)
     extent = builder.createConvert(loc, indexType, extent);
   return extents;
 }
 
 void hlfir::genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder,
                                 Entity entity,
if (auto concat = expr.getDefiningOp<hlfir::ConcatOp>()) {
       return;
     } else if (auto apply = expr.getDefiningOp<hlfir::ApplyOp>()) {
       result.append(apply.getTypeparams().begin(), apply.getTypeparams().end());
     }
     TODO(loc, "inquire type parameters of hlfir.expr");
   }
 
   if (entity.isCharacter()) {
-    auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
-    assert(!cleanup && "translation of entity should not yield cleanup");
-    result.push_back(fir::factory::readCharLen(builder, loc, exv));
+    result.push_back(genCharacterVariableLength(loc, builder, entity));
     return;
   }
   TODO(loc, "inquire PDTs length parameters in HLFIR");
 }
 
 mlir::Value hlfir::genCharLength(mlir::Location loc, fir::FirOpBuilder &builder,
                                  hlfir::Entity entity) {
   llvm::SmallVector<mlir::Value, 1> lenParams;
if (auto variableInterface = entity.getIfVariableInterface())
     return {fir::getBase(exv),
             asEmboxShape(loc, builder, exv, variableInterface.getShape())};
   return {fir::getBase(exv), builder.createShape(loc, exv)};
 }
 
 hlfir::Entity hlfir::derefPointersAndAllocatables(mlir::Location loc,
                                                   fir::FirOpBuilder &builder,
                                                   Entity entity) {
-  if (entity.isMutableBox())
-    return hlfir::Entity{builder.create<fir::LoadOp>(loc, entity).getResult()};
+  if (entity.isMutableBox()) {
+    hlfir::Entity boxLoad{builder.create<fir::LoadOp>(loc, entity)};
+    if (entity.isScalar()) {
+      mlir::Type elementType = boxLoad.getFortranElementType();
+      if (fir::isa_trivial(elementType))
+        return hlfir::Entity{builder.create<fir::BoxAddrOp>(loc, boxLoad)};
+      if (auto charType = elementType.dyn_cast<fir::CharacterType>()) {
+        mlir::Value base = builder.create<fir::BoxAddrOp>(loc, boxLoad);
+        if (charType.hasConstantLen())
+          return hlfir::Entity{base};
+        mlir::Value len = genCharacterVariableLength(loc, builder, entity);
+        auto boxCharType =
+            fir::BoxCharType::get(builder.getContext(), charType.getFKind());
+        return hlfir::Entity{
+            builder.create<fir::EmboxCharOp>(loc, boxCharType, base, len)
+                .getResult()};
+      }
+    }
+    // Keep the entity boxed for now.
+    return boxLoad;
+  }
   return entity;
 }
 
 mlir::Type hlfir::getVariableElementType(hlfir::Entity variable) {
   assert(variable.isVariable() && "entity must be a variable");
   if (variable.isScalar())
     return variable.getType();
   mlir::Type eleTy = variable.getFortranElementType();
for (auto extent : llvm::reverse(extents)) {
     innerLoop = builder.create<fir::DoLoopOp>(loc, one, ub, one);
     builder.setInsertionPointToStart(innerLoop.getBody());
     // Reverse the indices so they are in column-major order.
     indices[dim--] = innerLoop.getInductionVar();
   }
   builder.restoreInsertionPoint(insPt);
   return {innerLoop, indices};
 }
+
+static fir::ExtendedValue
+translateVariableToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
+                                 hlfir::Entity variable) {
+  assert(variable.isVariable() && "must be a variable");
+  /// When going towards FIR, use the original base value to avoid
+  /// introducing descriptors at runtime when they are not required.
+  mlir::Value firBase = variable.getFirBase();
+  if (variable.isMutableBox())
+    return fir::MutableBoxValue(firBase, getExplicitTypeParams(variable),
+                                fir::MutableProperties{});
+
+  if (firBase.getType().isa<fir::BaseBoxType>()) {
+    if (!variable.isSimplyContiguous() || variable.isPolymorphic() ||
+        variable.isDerivedWithLengthParameters()) {
+      llvm::SmallVector<mlir::Value> nonDefaultLbounds =
+          getNonDefaultLowerBounds(loc, builder, variable);
+      return fir::BoxValue(firBase, nonDefaultLbounds,
+                           getExplicitTypeParams(variable));
+    }
+    // Otherwise, the variable can be represented in a fir::ExtendedValue
+    // without the overhead of a fir.box.
+    firBase = genVariableRawAddress(loc, builder, variable);
+  }
+
+  if (variable.isScalar()) {
+    if (variable.isCharacter()) {
+      if (firBase.getType().isa<fir::BoxCharType>())
+        return genUnboxChar(loc, builder, firBase);
+      mlir::Value len = genCharacterVariableLength(loc, builder, variable);
+      return fir::CharBoxValue{firBase, len};
+    }
+    return firBase;
+  }
+  llvm::SmallVector<mlir::Value> extents;
+  llvm::SmallVector<mlir::Value> nonDefaultLbounds;
+  if (variable.getType().isa<fir::BaseBoxType>() &&
+      !variable.getIfVariableInterface()) {
+    // This special case avoids generating two generating to sets of identical
+    // fir.box_dim to get both the lower bounds and extents.
+    genLboundsAndExtentsFromBox(loc, builder, variable, nonDefaultLbounds,
+                                &extents);
+  } else {
+    extents = getVariableExtents(loc, builder, variable);
+    nonDefaultLbounds = getNonDefaultLowerBounds(loc, builder, variable);
+  }
+  if (variable.isCharacter())
+    return fir::CharArrayBoxValue{
+        firBase, genCharacterVariableLength(loc, builder, variable), extents,
+        nonDefaultLbounds};
+  return fir::ArrayBoxValue{firBase, extents, nonDefaultLbounds};
+}
+
+fir::ExtendedValue
+hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
+                                fir::FortranVariableOpInterface var) {
+  return translateVariableToExtendedValue(loc, builder, var);
+}
+
+std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
+hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
+                                hlfir::Entity entity) {
+  if (entity.isVariable())
+    return {translateVariableToExtendedValue(loc, builder, entity),
+            std::nullopt};
+
+  if (entity.getType().isa<hlfir::ExprType>()) {
+    hlfir::AssociateOp associate = hlfir::genAssociateExpr(
+        loc, builder, entity, entity.getType(), "adapt.valuebyref");
+    auto *bldr = &builder;
+    hlfir::CleanupFunction cleanup = [bldr, loc, associate]() -> void {
+      bldr->create<hlfir::EndAssociateOp>(loc, associate);
+    };
+    hlfir::Entity temp{associate.getBase()};
+    return {translateToExtendedValue(loc, builder, temp).first, cleanup};
+  }
+  return {{static_cast<mlir::Value>(entity)}, {}};
+}

flang/lib/Optimizer/Dialect/FIROps.cpp

if (indSize < arrTy.getDimension())
     return emitOpError("number of indices must match array dimension");
   return mlir::success();
 }
 
 //===----------------------------------------------------------------------===//
 // BoxAddrOp
 //===----------------------------------------------------------------------===//
 
+void fir::BoxAddrOp::build(mlir::OpBuilder &builder,
+                           mlir::OperationState &result, mlir::Value val) {
+  mlir::Type type =
+      llvm::TypeSwitch<mlir::Type, mlir::Type>(val.getType())
+          .Case<fir::BoxType>([&](fir::BoxType ty) -> mlir::Type {
+            mlir::Type eleTy = ty.getEleTy();
+            if (fir::isa_ref_type(eleTy))
+              return eleTy;
+            return fir::ReferenceType::get(eleTy);
+          })
+          .Case<fir::BoxCharType>([&](fir::BoxCharType ty) -> mlir::Type {
+            return fir::ReferenceType::get(ty.getEleTy());
+          })
+          .Case<fir::BoxProcType>(
+              [&](fir::BoxProcType ty) { return ty.getEleTy(); })
+          .Default([&](const auto &) { return mlir::Type{}; });
+  assert(type && "bad val type");
+  build(builder, result, type, val);
+}
+
 mlir::OpFoldResult fir::BoxAddrOp::fold(FoldAdaptor adaptor) {
   if (auto *v = getVal().getDefiningOp()) {
     if (auto box = mlir::dyn_cast<fir::EmboxOp>(v)) {
       if (!box.getSlice()) // Fold only if not sliced
         return box.getMemref();
     }
     if (auto box = mlir::dyn_cast<fir::EmboxCharOp>(v))
       return box.getMemref();

flang/test/Lower/HLFIR/allocatables-and-pointers.f90

+! Test lowering of whole allocatable and pointers to HLFIR
+! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
+
+subroutine passing_allocatable(x)
+  interface
+    subroutine takes_allocatable(y)
+      real, allocatable :: y(:)
+    end subroutine
+    subroutine takes_array(y)
+      real :: y(*)
+    end subroutine
+  end interface
+  real, allocatable :: x(:)
+  call takes_allocatable(x)
+  call takes_array(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPpassing_allocatable(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name =  {{.*}}Ex"}
+! CHECK:  fir.call @_QPtakes_allocatable(%[[VAL_1]]#0) {{.*}} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+! CHECK:  %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
+! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK:  fir.call @_QPtakes_array(%[[VAL_4]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> ()
+
+subroutine passing_pointer(x)
+  interface
+    subroutine takes_pointer(y)
+      real, pointer :: y(:)
+    end subroutine
+  end interface
+  real, pointer :: x(:)
+  call takes_pointer(x)
+  call takes_pointer(NULL())
+end subroutine
+! CHECK-LABEL: func.func @_QPpassing_pointer(
+! CHECK:  %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name =  {{.*}}Ex"}
+! CHECK:  fir.call @_QPtakes_pointer(%[[VAL_2]]#0) {{.*}} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> ()
+! CHECK:  %[[VAL_3:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_6:.*]] = fir.embox %[[VAL_3]](%[[VAL_5]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK:  fir.store %[[VAL_6]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:  fir.call @_QPtakes_pointer(%[[VAL_1]]) {{.*}} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> ()
+
+subroutine passing_contiguous_pointer(x)
+  interface
+    subroutine takes_array(y)
+      real :: y(*)
+    end subroutine
+  end interface
+  real, pointer, contiguous :: x(:)
+  call takes_array(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPpassing_contiguous_pointer(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<contiguous, pointer>, uniq_name =  {{.*}}Ex"}
+! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:  %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK:  fir.call @_QPtakes_array(%[[VAL_4]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> ()
+
+subroutine character_allocatable_cst_len(x)
+  character(10), allocatable :: x
+  call takes_char(x)
+  call takes_char(x//"hello")
+end subroutine
+! CHECK-LABEL: func.func @_QPcharacter_allocatable_cst_len(
+! CHECK:  %[[VAL_1:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] typeparams %[[VAL_1:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name =  {{.*}}Ex"}
+! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>
+! CHECK:  %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.heap<!fir.char<1,10>>>) -> !fir.heap<!fir.char<1,10>>
+! CHECK:  %[[VAL_5:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_4]] : (!fir.heap<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,10>>
+! CHECK:  %[[VAL_7:.*]] = fir.emboxchar %[[VAL_6]], %[[VAL_5]] : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>
+! CHECK:  fir.call @_QPtakes_char(%[[VAL_7]]) {{.*}} : (!fir.boxchar<1>) -> ()
+! CHECK:  %[[VAL_8:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>
+! CHECK:  %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box<!fir.heap<!fir.char<1,10>>>) -> !fir.heap<!fir.char<1,10>>
+! CHECK:  %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_10:[a-z0-9]*]] typeparams %[[VAL_11:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<parameter>
+! CHECK:  %[[VAL_13:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_11]] : index
+! CHECK:  %[[VAL_15:.*]] = hlfir.concat %[[VAL_9]], %[[VAL_12]]#0 len %[[VAL_14]] : (!fir.heap<!fir.char<1,10>>, !fir.ref<!fir.char<1,5>>, index) -> !hlfir.expr<!fir.char<1,15>>
+
+subroutine character_allocatable_dyn_len(x, l)
+  integer(8) :: l
+  character(l), allocatable :: x
+  call takes_char(x)
+  call takes_char(x//"hello")
+end subroutine
+! CHECK-LABEL: func.func @_QPcharacter_allocatable_dyn_len(
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {uniq_name =  {{.*}}El"}
+! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<i64>
+! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : i64
+! CHECK:  %[[VAL_5:.*]] = arith.cmpi sgt, %[[VAL_3]], %[[VAL_4]] : i64
+! CHECK:  %[[VAL_6:.*]] = arith.select %[[VAL_5]], %[[VAL_3]], %[[VAL_4]] : i64
+! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] typeparams %[[VAL_6:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name =  {{.*}}Ex"}
+! CHECK:  %[[VAL_8:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+! CHECK:  %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
+! CHECK:  %[[VAL_10:.*]] = fir.emboxchar %[[VAL_9]], %[[VAL_6]] : (!fir.heap<!fir.char<1,?>>, i64) -> !fir.boxchar<1>
+! CHECK:  fir.call @_QPtakes_char(%[[VAL_10]]) {{.*}} : (!fir.boxchar<1>) -> ()
+! CHECK:  %[[VAL_11:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+! CHECK:  %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
+! CHECK:  %[[VAL_13:.*]] = fir.emboxchar %[[VAL_12]], %[[VAL_6]] : (!fir.heap<!fir.char<1,?>>, i64) -> !fir.boxchar<1>
+! CHECK:  %[[VAL_16:.*]]:2 = hlfir.declare %[[VAL_14:[a-z0-9]*]] typeparams %[[VAL_15:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<parameter>
+! CHECK:  %[[VAL_17:.*]] = fir.convert %[[VAL_6]] : (i64) -> index
+! CHECK:  %[[VAL_18:.*]] = arith.addi %[[VAL_17]], %[[VAL_15]] : index
+! CHECK:  %[[VAL_19:.*]] = hlfir.concat %[[VAL_13]], %[[VAL_16]]#0 len %[[VAL_18]] : (!fir.boxchar<1>, !fir.ref<!fir.char<1,5>>, index) -> !hlfir.expr<!fir.char<1,?>>
+
+subroutine print_allocatable(x)
+  real, allocatable :: x(:)
+  print *, x
+end subroutine
+! CHECK-LABEL: func.func @_QPprint_allocatable(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name =  {{.*}}Ex"}
+! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.box<none>
+! CHECK:  %[[VAL_9:.*]] = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[VAL_8]])
+
+subroutine print_pointer(x)
+  real, pointer :: x(:)
+  print *, x
+end subroutine
+! CHECK-LABEL: func.func @_QPprint_pointer(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name =  {{.*}}Ex"}
+! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
+! CHECK:  %[[VAL_9:.*]] = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[VAL_8]])
+
+subroutine elemental_expr(x)
+  integer, pointer :: x(:, :)
+  call takes_array_2(x+42)
+end subroutine
+! CHECK-LABEL: func.func @_QPelemental_expr(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name =  {{.*}}Ex"}
+! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xi32>>>>
+! CHECK:  %[[VAL_3:.*]] = arith.constant 42 : i32
+! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+! CHECK:  %[[VAL_6:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+! CHECK:  %[[VAL_8:.*]] = fir.shape %[[VAL_5]]#1, %[[VAL_7]]#1 : (index, index) -> !fir.shape<2>
+! CHECK:  %[[VAL_9:.*]] = hlfir.elemental %[[VAL_8]] : (!fir.shape<2>) -> !hlfir.expr<?x?xi32> {
+! CHECK:  ^bb0(%[[VAL_10:.*]]: index, %[[VAL_11:.*]]: index):
+! CHECK:    %[[VAL_12:.*]] = arith.constant 0 : index
+! CHECK:    %[[VAL_13:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_12]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+! CHECK:    %[[VAL_14:.*]] = arith.constant 1 : index
+! CHECK:    %[[VAL_15:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_14]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+! CHECK:    %[[VAL_16:.*]] = arith.constant 1 : index
+! CHECK:    %[[VAL_17:.*]] = arith.subi %[[VAL_13]]#0, %[[VAL_16]] : index
+! CHECK:    %[[VAL_18:.*]] = arith.addi %[[VAL_10]], %[[VAL_17]] : index
+! CHECK:    %[[VAL_19:.*]] = arith.subi %[[VAL_15]]#0, %[[VAL_16]] : index
+! CHECK:    %[[VAL_20:.*]] = arith.addi %[[VAL_11]], %[[VAL_19]] : index
+! CHECK:    %[[VAL_21:.*]] = hlfir.designate %[[VAL_2]] (%[[VAL_18]], %[[VAL_20]])  : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index, index) -> !fir.ref<i32>
+! CHECK:    %[[VAL_22:.*]] = fir.load %[[VAL_21]] : !fir.ref<i32>
+! CHECK:    %[[VAL_23:.*]] = arith.addi %[[VAL_22]], %[[VAL_3]] : i32
+! CHECK:    hlfir.yield_element %[[VAL_23]] : i32
+! CHECK:  }