[flang][hlfir] Enable allocate, deallocate, pointer assignment lowering

[jeanPerier]

Summary

The previous patches allowed lowering allocatable/and pointer designator
expressions with HLFIR.
This patch updates the bridge genExprMutableBox to use HLFIR lowering
when HLFIR flag is set. For allocate and deallocate lowering that use
genExprMutableBox, no other change is needed.

For pointer assignments, the code doing the pointer assignments in the
bridge can be reused and is simply moved so that it can be shared, and
the "explicit context" special cases of the previous lowering are
by-passed.

The code doing pointer assignment revealed that convertExprToAddress
did not match the previous genExprAddr behavior (that actually
does not create temps for "x" where x is not contiguous).
Instead of trying to copy the old behavior that is a bit weird (was
dictated by the implementation rather than design). Update
convertExprToAddress to do something sensible and that works with
the current genExprAddr usages (if anything, it should saves bogus
array section temps).

[clementval]

LGTM

flang/include/flang/Lower/ConvertExprToHLFIR.h

fir::BoxValue convertExprToBox(mlir::Location loc,
                                const Fortran::lower::SomeExpr &,
                                Fortran::lower::SymMap &,
                                Fortran::lower::StatementContext &);
 fir::BoxValue convertToBox(mlir::Location loc,
                            Fortran::lower::AbstractConverter &,
                            hlfir::Entity entity,
                            Fortran::lower::StatementContext &);
 
-/// Lower an evaluate::Expr to fir::ExtendedValue raw address.
-/// Beware that this will create a temporary for non simply contiguous
-/// designator expressions.
+/// Lower an evaluate::Expr to fir::ExtendedValue address.
+/// The address may be a raw fir.ref<T>, or a fir.box<T>/fir.class<T>, (pointer
+/// and allocatable are dereferenced).
+/// - If expression is not a variable, or is a designator with vector
+///   subscripts, a temporary is created to hold the expression value and
+///   is returned as:
+///   - a fir.class<T> if the expression is polymorphic.
+///   - otherwise, a fir.box<T> if it is a derived type with length
+///     parameters (not yet implemented).
+///   - otherwise, a fir.ref<T>
+/// - If the expression is a variable that is not a designator with
+///   vector subscripts, it is lowered without creating a temporary and
+///   is returned as:
+///   - a fir.class<T> if the variable is polymorphic.
+///   - otherwise, a fir.box<T> if it is a derived type with length
+///     parameters (not yet implemented), or if it is not a simply
+///     contiguous.
+///   - otherwise, a fir.ref<T>
+///
+/// Beware that this is different from the previous createSomeExtendedAddress
+/// that had a non-trivial behaviour and would create contiguous temporary for
+/// array sections `x(:, :)`, but not for `x` even if x is not simply
+/// contiguous.
 fir::ExtendedValue convertExprToAddress(mlir::Location loc,
                                         Fortran::lower::AbstractConverter &,
                                         const Fortran::lower::SomeExpr &,
                                         Fortran::lower::SymMap &,
                                         Fortran::lower::StatementContext &);
 fir::ExtendedValue convertToAddress(mlir::Location loc,
                                     Fortran::lower::AbstractConverter &,
                                     hlfir::Entity entity,
-                                    bool isSimplyContiguous,
                                     Fortran::lower::StatementContext &);
 
 /// Lower an evaluate::Expr to a fir::ExtendedValue value.
 fir::ExtendedValue convertExprToValue(mlir::Location loc,
                                       Fortran::lower::AbstractConverter &,
                                       const Fortran::lower::SomeExpr &,
                                       Fortran::lower::SymMap &,
                                       Fortran::lower::StatementContext &);
 fir::ExtendedValue convertToValue(mlir::Location loc,
                                   Fortran::lower::AbstractConverter &,
                                   hlfir::Entity entity,
                                   Fortran::lower::StatementContext &);
+
+/// Lower an evaluate::Expr to a fir::MutableBoxValue value.
+/// This can only be called if the Expr is a POINTER or ALLOCATABLE,
+/// otherwise, this will crash.
+fir::MutableBoxValue
+convertExprToMutableBox(mlir::Location loc, Fortran::lower::AbstractConverter &,
+                        const Fortran::lower::SomeExpr &,
+                        Fortran::lower::SymMap &);
 } // namespace Fortran::lower
 
 #endif // FORTRAN_LOWER_CONVERTEXPRTOHLFIR_H

flang/lib/Lower/Allocatable.cpp

void Fortran::lower::associateMutableBox(
     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
     const fir::MutableBoxValue &box, const Fortran::lower::SomeExpr &source,
     mlir::ValueRange lbounds, Fortran::lower::StatementContext &stmtCtx) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(source)) {
     fir::factory::disassociateMutableBox(builder, loc, box);
     return;
   }
-
+  if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
+    fir::ExtendedValue rhs = converter.genExprAddr(loc, source, stmtCtx);
+    fir::factory::associateMutableBox(builder, loc, box, rhs, lbounds);
+    return;
+  }
   // The right hand side is not be evaluated into a temp. Array sections can
   // typically be represented as a value of type `!fir.box`. However, an
   // expression that uses vector subscripts cannot be emboxed. In that case,
   // generate a reference to avoid having to later use a fir.rebox to implement
   // the pointer association.
   fir::ExtendedValue rhs = isArraySectionWithoutVectorSubscript(source)
                                ? converter.genExprBox(loc, source, stmtCtx)
                                : converter.genExprAddr(loc, source, stmtCtx);

flang/lib/Lower/Bridge.cpp

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 {
-    if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) {
+    if (lowerToHighLevelFIR()) {
       auto srcDef = localSymbols.lookupVariableDefinition(src);
       assert(srcDef && "source binding does not exists");
       localSymbols.addVariableDefinition(target, *srcDef);
     } else {
       localSymbols.addSymbol(target, lookupSymbol(src).toExtendedValue());
     }
   }
 
lookupLabel(Fortran::lower::pft::Label label) override final {
     return iter->second;
   }
 
   fir::ExtendedValue
   genExprAddr(const Fortran::lower::SomeExpr &expr,
               Fortran::lower::StatementContext &context,
               mlir::Location *locPtr = nullptr) override final {
     mlir::Location loc = locPtr ? *locPtr : toLocation();
-    if (bridge.getLoweringOptions().getLowerToHighLevelFIR())
+    if (lowerToHighLevelFIR())
       return Fortran::lower::convertExprToAddress(loc, *this, expr,
                                                   localSymbols, context);
     return Fortran::lower::createSomeExtendedAddress(loc, *this, expr,
                                                      localSymbols, context);
   }
 
   fir::ExtendedValue
   genExprValue(const Fortran::lower::SomeExpr &expr,
                Fortran::lower::StatementContext &context,
                mlir::Location *locPtr = nullptr) override final {
     mlir::Location loc = locPtr ? *locPtr : toLocation();
-    if (bridge.getLoweringOptions().getLowerToHighLevelFIR())
+    if (lowerToHighLevelFIR())
       return Fortran::lower::convertExprToValue(loc, *this, expr, localSymbols,
                                                 context);
     return Fortran::lower::createSomeExtendedExpression(loc, *this, expr,
                                                         localSymbols, context);
   }
 
   fir::ExtendedValue
   genExprBox(mlir::Location loc, const Fortran::lower::SomeExpr &expr,
              Fortran::lower::StatementContext &stmtCtx) override final {
-    if (bridge.getLoweringOptions().getLowerToHighLevelFIR())
+    if (lowerToHighLevelFIR())
       return Fortran::lower::convertExprToBox(loc, *this, expr, localSymbols,
                                               stmtCtx);
     return Fortran::lower::createBoxValue(loc, *this, expr, localSymbols,
                                           stmtCtx);
   }
 
   Fortran::evaluate::FoldingContext &getFoldingContext() override final {
     return foldingContext;
mlir::Value createFIRExpr(mlir::Location loc,
                             const Fortran::lower::SomeExpr *expr,
                             Fortran::lower::StatementContext &stmtCtx) {
     return fir::getBase(genExprValue(*expr, stmtCtx, &loc));
   }
 
   /// Find the symbol in the local map or return null.
   Fortran::lower::SymbolBox
   lookupSymbol(const Fortran::semantics::Symbol &sym) {
-    if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) {
+    if (lowerToHighLevelFIR()) {
       if (std::optional<fir::FortranVariableOpInterface> var =
               localSymbols.lookupVariableDefinition(sym)) {
         auto exv =
             hlfir::translateToExtendedValue(toLocation(), *builder, *var);
         return exv.match(
             [](mlir::Value x) -> Fortran::lower::SymbolBox {
               return Fortran::lower::SymbolBox::Intrinsic{x};
             },
private:
 
   /// Lowering of CALL statement
   void genFIR(const Fortran::parser::CallStmt &stmt) {
     Fortran::lower::StatementContext stmtCtx;
     Fortran::lower::pft::Evaluation &eval = getEval();
     setCurrentPosition(stmt.v.source);
     assert(stmt.typedCall && "Call was not analyzed");
     mlir::Value res{};
-    if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) {
+    if (lowerToHighLevelFIR()) {
       std::optional<mlir::Type> resultType;
       if (stmt.typedCall->hasAlternateReturns())
         resultType = builder->getIndexType();
       auto hlfirRes = Fortran::lower::convertCallToHLFIR(
           toLocation(), *this, *stmt.typedCall, resultType, localSymbols,
           stmtCtx);
       if (hlfirRes)
         res = *hlfirRes;
const Fortran::semantics::Symbol *sym =
         Fortran::evaluate::GetFirstSymbol(expr);
     return sym && sym->IsFuncResult();
   }
 #endif
 
   inline fir::MutableBoxValue
   genExprMutableBox(mlir::Location loc,
                     const Fortran::lower::SomeExpr &expr) override final {
+    if (lowerToHighLevelFIR())
+      return Fortran::lower::convertExprToMutableBox(loc, *this, expr,
+                                                     localSymbols);
     return Fortran::lower::createMutableBox(loc, *this, expr, localSymbols);
   }
 
+  // Generate pointer assignment with possibly empty bounds-spec. R1035: a
+  // bounds-spec is a lower bound value.
+  void genPointerAssignment(
+      mlir::Location loc, const Fortran::evaluate::Assignment &assign,
+      const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
+    Fortran::lower::StatementContext stmtCtx;
+    if (Fortran::evaluate::IsProcedure(assign.rhs))
+      TODO(loc, "procedure pointer assignment");
+
+    std::optional<Fortran::evaluate::DynamicType> lhsType =
+        assign.lhs.GetType();
+    // Delegate pointer association to unlimited polymorphic pointer
+    // to the runtime. element size, type code, attribute and of
+    // course base_addr might need to be updated.
+    if (lhsType && lhsType->IsPolymorphic()) {
+      if (!lowerToHighLevelFIR() && explicitIterationSpace())
+        TODO(loc, "polymorphic pointer assignment in FORALL");
+      mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr();
+      mlir::Value rhs = fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
+      Fortran::lower::genPointerAssociate(*builder, loc, lhs, rhs);
+      return;
+    }
+
+    llvm::SmallVector<mlir::Value> lbounds;
+    for (const Fortran::evaluate::ExtentExpr &lbExpr : lbExprs)
+      lbounds.push_back(fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
+    if (!lowerToHighLevelFIR() && explicitIterationSpace()) {
+      // Pointer assignment in FORALL context. Copy the rhs box value
+      // into the lhs box variable.
+      genArrayAssignment(assign, stmtCtx, lbounds);
+      return;
+    }
+    fir::MutableBoxValue lhs = genExprMutableBox(loc, assign.lhs);
+    Fortran::lower::associateMutableBox(*this, loc, lhs, assign.rhs, lbounds,
+                                        stmtCtx);
+  }
+  // Pointer assignment with bounds-remapping. R1036: a bounds-remapping is a
+  // pair, lower bound and upper bound.
+  void genPointerAssignment(
+      mlir::Location loc, const Fortran::evaluate::Assignment &assign,
+      const Fortran::evaluate::Assignment::BoundsRemapping &boundExprs) {
+    Fortran::lower::StatementContext stmtCtx;
+    llvm::SmallVector<mlir::Value> lbounds;
+    llvm::SmallVector<mlir::Value> ubounds;
+    for (const std::pair<Fortran::evaluate::ExtentExpr,
+                         Fortran::evaluate::ExtentExpr> &pair : boundExprs) {
+      const Fortran::evaluate::ExtentExpr &lbExpr = pair.first;
+      const Fortran::evaluate::ExtentExpr &ubExpr = pair.second;
+      lbounds.push_back(fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
+      ubounds.push_back(fir::getBase(genExprValue(toEvExpr(ubExpr), stmtCtx)));
+    }
+
+    std::optional<Fortran::evaluate::DynamicType> lhsType =
+        assign.lhs.GetType();
+    std::optional<Fortran::evaluate::DynamicType> rhsType =
+        assign.rhs.GetType();
+    // Polymorphic lhs/rhs need more care. See F2018 10.2.2.3.
+    if ((lhsType && lhsType->IsPolymorphic()) ||
+        (rhsType && rhsType->IsPolymorphic())) {
+      if (!lowerToHighLevelFIR() && explicitIterationSpace())
+        TODO(loc, "polymorphic pointer assignment in FORALL");
+
+      mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr();
+      mlir::Value rhs = fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
+
+      // Create the newRank x 2 array with the bounds to be passed to
+      // the runtime as a descriptor.
+      assert(lbounds.size() && ubounds.size());
+      mlir::Type indexTy = builder->getIndexType();
+      mlir::Type boundArrayTy = fir::SequenceType::get(
+          {static_cast<int64_t>(lbounds.size()) * 2}, builder->getI64Type());
+      mlir::Value boundArray =
+          builder->create<fir::AllocaOp>(loc, boundArrayTy);
+      mlir::Value array = builder->create<fir::UndefOp>(loc, boundArrayTy);
+      for (unsigned i = 0; i < lbounds.size(); ++i) {
+        array = builder->create<fir::InsertValueOp>(
+            loc, boundArrayTy, array, lbounds[i],
+            builder->getArrayAttr({builder->getIntegerAttr(
+                builder->getIndexType(), static_cast<int>(i * 2))}));
+        array = builder->create<fir::InsertValueOp>(
+            loc, boundArrayTy, array, ubounds[i],
+            builder->getArrayAttr({builder->getIntegerAttr(
+                builder->getIndexType(), static_cast<int>(i * 2 + 1))}));
+      }
+      builder->create<fir::StoreOp>(loc, array, boundArray);
+      mlir::Type boxTy = fir::BoxType::get(boundArrayTy);
+      mlir::Value ext =
+          builder->createIntegerConstant(loc, indexTy, lbounds.size() * 2);
+      mlir::Value shapeOp = builder->genShape(loc, {ext});
+      mlir::Value boundsDesc =
+          builder->create<fir::EmboxOp>(loc, boxTy, boundArray, shapeOp);
+      Fortran::lower::genPointerAssociateRemapping(*builder, loc, lhs, rhs,
+                                                   boundsDesc);
+      return;
+    }
+    if (!lowerToHighLevelFIR() && explicitIterationSpace()) {
+      // Pointer assignment in FORALL context. Copy the rhs box value
+      // into the lhs box variable.
+      genArrayAssignment(assign, stmtCtx, lbounds, ubounds);
+      return;
+    }
+    fir::MutableBoxValue lhs = genExprMutableBox(loc, assign.lhs);
+    if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+            assign.rhs)) {
+      fir::factory::disassociateMutableBox(*builder, loc, lhs);
+      return;
+    }
+    // Do not generate a temp in case rhs is an array section.
+    fir::ExtendedValue rhs =
+        Fortran::lower::isArraySectionWithoutVectorSubscript(assign.rhs)
+            ? Fortran::lower::createSomeArrayBox(*this, assign.rhs,
+                                                 localSymbols, stmtCtx)
+            : genExprAddr(assign.rhs, stmtCtx);
+    fir::factory::associateMutableBoxWithRemap(*builder, loc, lhs, rhs, lbounds,
+                                               ubounds);
+    if (!lowerToHighLevelFIR() && explicitIterationSpace()) {
+      mlir::ValueRange inners = explicitIterSpace.getInnerArgs();
+      if (!inners.empty())
+        builder->create<fir::ResultOp>(loc, inners);
+    }
+  }
+
   /// Shared for both assignments and pointer assignments.
   void genAssignment(const Fortran::evaluate::Assignment &assign) {
-    Fortran::lower::StatementContext stmtCtx;
     mlir::Location loc = toLocation();
-    if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) {
+    if (lowerToHighLevelFIR()) {
       if (explicitIterationSpace() || !implicitIterSpace.empty())
         TODO(loc, "HLFIR assignment inside FORALL or WHERE");
       auto &builder = getFirOpBuilder();
       std::visit(
           Fortran::common::visitors{
               // [1] Plain old assignment.
               [&](const Fortran::evaluate::Assignment::Intrinsic &) {
+                Fortran::lower::StatementContext stmtCtx;
                 if (Fortran::lower::isWholeAllocatable(assign.lhs))
                   TODO(loc, "HLFIR assignment to whole allocatable");
                 hlfir::EntityWithAttributes rhs =
                     Fortran::lower::convertExprToHLFIR(loc, *this, assign.rhs,
                                                        localSymbols, stmtCtx);
                 hlfir::EntityWithAttributes lhs =
                     Fortran::lower::convertExprToHLFIR(loc, *this, assign.lhs,
                                                        localSymbols, stmtCtx);
                 builder.create<hlfir::AssignOp>(loc, rhs, lhs);
               },
               // [2] User defined assignment. If the context is a scalar
               // expression then call the procedure.
               [&](const Fortran::evaluate::ProcedureRef &procRef) {
                 TODO(loc, "HLFIR user defined assignment");
               },
-              // [3] Pointer assignment with possibly empty bounds-spec. R1035:
-              // a bounds-spec is a lower bound value.
               [&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
-                TODO(loc, "HLFIR pointer assignment");
+                genPointerAssignment(loc, assign, lbExprs);
               },
-              // [4] Pointer assignment with bounds-remapping. R1036: a
-              // bounds-remapping is a pair, lower bound and upper bound.
-              [&](const Fortran::evaluate::Assignment::BoundsRemapping) {
-                TODO(loc, "HLFIR pointer assignment with bounds remapping");
+              [&](const Fortran::evaluate::Assignment::BoundsRemapping
+                      &boundExprs) {
+                genPointerAssignment(loc, assign, boundExprs);
               },
           },
           assign.u);
       return;
     }
     if (explicitIterationSpace()) {
       Fortran::lower::createArrayLoads(*this, explicitIterSpace, localSymbols);
       explicitIterSpace.genLoopNest();
     }
+    Fortran::lower::StatementContext stmtCtx;
     std::visit(
         Fortran::common::visitors{
             // [1] Plain old assignment.
             [&](const Fortran::evaluate::Assignment::Intrinsic &) {
               const Fortran::semantics::Symbol *sym =
                   Fortran::evaluate::GetLastSymbol(assign.lhs);
 
               if (!sym)
std::visit(
               Fortran::lower::StatementContext &ctx =
                   explicitIterationSpace() ? explicitIterSpace.stmtContext()
                                            : stmtCtx;
               Fortran::lower::createSubroutineCall(
                   *this, procRef, explicitIterSpace, implicitIterSpace,
                   localSymbols, ctx, /*isUserDefAssignment=*/true);
             },
 
-            // [3] Pointer assignment with possibly empty bounds-spec. R1035: a
-            // bounds-spec is a lower bound value.
             [&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
-              if (Fortran::evaluate::IsProcedure(assign.rhs))
-                TODO(loc, "procedure pointer assignment");
-
-              std::optional<Fortran::evaluate::DynamicType> lhsType =
-                  assign.lhs.GetType();
-              // Delegate pointer association to unlimited polymorphic pointer
-              // to the runtime. element size, type code, attribute and of
-              // course base_addr might need to be updated.
-              if (lhsType && lhsType->IsPolymorphic()) {
-                if (explicitIterationSpace())
-                  TODO(loc, "polymorphic pointer assignment in FORALL");
-                mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr();
-                mlir::Value rhs =
-                    fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
-                Fortran::lower::genPointerAssociate(*builder, loc, lhs, rhs);
-                return;
-              }
-
-              llvm::SmallVector<mlir::Value> lbounds;
-              for (const Fortran::evaluate::ExtentExpr &lbExpr : lbExprs)
-                lbounds.push_back(
-                    fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
-              if (explicitIterationSpace()) {
-                // Pointer assignment in FORALL context. Copy the rhs box value
-                // into the lhs box variable.
-                genArrayAssignment(assign, stmtCtx, lbounds);
-                return;
-              }
-              fir::MutableBoxValue lhs = genExprMutableBox(loc, assign.lhs);
-              Fortran::lower::associateMutableBox(*this, loc, lhs, assign.rhs,
-                                                  lbounds, stmtCtx);
+              return genPointerAssignment(loc, assign, lbExprs);
             },
-
-            // [4] Pointer assignment with bounds-remapping. R1036: a
-            // bounds-remapping is a pair, lower bound and upper bound.
             [&](const Fortran::evaluate::Assignment::BoundsRemapping
                     &boundExprs) {
-              llvm::SmallVector<mlir::Value> lbounds;
-              llvm::SmallVector<mlir::Value> ubounds;
-              for (const std::pair<Fortran::evaluate::ExtentExpr,
-                                   Fortran::evaluate::ExtentExpr> &pair :
-                   boundExprs) {
-                const Fortran::evaluate::ExtentExpr &lbExpr = pair.first;
-                const Fortran::evaluate::ExtentExpr &ubExpr = pair.second;
-                lbounds.push_back(
-                    fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
-                ubounds.push_back(
-                    fir::getBase(genExprValue(toEvExpr(ubExpr), stmtCtx)));
-              }
-
-              std::optional<Fortran::evaluate::DynamicType> lhsType =
-                  assign.lhs.GetType();
-              std::optional<Fortran::evaluate::DynamicType> rhsType =
-                  assign.rhs.GetType();
-              // Polymorphic lhs/rhs need more care. See F2018 10.2.2.3.
-              if ((lhsType && lhsType->IsPolymorphic()) ||
-                  (rhsType && rhsType->IsPolymorphic())) {
-                if (explicitIterationSpace())
-                  TODO(loc, "polymorphic pointer assignment in FORALL");
-
-                mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr();
-                mlir::Value rhs =
-                    fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
-
-                // Create the newRank x 2 array with the bounds to be passed to
-                // the runtime as a descriptor.
-                assert(lbounds.size() && ubounds.size());
-                mlir::Type indexTy = builder->getIndexType();
-                mlir::Type boundArrayTy = fir::SequenceType::get(
-                    {static_cast<int64_t>(lbounds.size()) * 2},
-                    builder->getI64Type());
-                mlir::Value boundArray =
-                    builder->create<fir::AllocaOp>(loc, boundArrayTy);
-                mlir::Value array =
-                    builder->create<fir::UndefOp>(loc, boundArrayTy);
-                for (unsigned i = 0; i < lbounds.size(); ++i) {
-                  array = builder->create<fir::InsertValueOp>(
-                      loc, boundArrayTy, array, lbounds[i],
-                      builder->getArrayAttr({builder->getIntegerAttr(
-                          builder->getIndexType(), static_cast<int>(i * 2))}));
-                  array = builder->create<fir::InsertValueOp>(
-                      loc, boundArrayTy, array, ubounds[i],
-                      builder->getArrayAttr({builder->getIntegerAttr(
-                          builder->getIndexType(),
-                          static_cast<int>(i * 2 + 1))}));
-                }
-                builder->create<fir::StoreOp>(loc, array, boundArray);
-                mlir::Type boxTy = fir::BoxType::get(boundArrayTy);
-                mlir::Value ext = builder->createIntegerConstant(
-                    loc, indexTy, lbounds.size() * 2);
-                mlir::Value shapeOp = builder->genShape(loc, {ext});
-                mlir::Value boundsDesc = builder->create<fir::EmboxOp>(
-                    loc, boxTy, boundArray, shapeOp);
-                Fortran::lower::genPointerAssociateRemapping(*builder, loc, lhs,
-                                                             rhs, boundsDesc);
-                return;
-              }
-              if (explicitIterationSpace()) {
-                // Pointer assignment in FORALL context. Copy the rhs box value
-                // into the lhs box variable.
-                genArrayAssignment(assign, stmtCtx, lbounds, ubounds);
-                return;
-              }
-              fir::MutableBoxValue lhs = genExprMutableBox(loc, assign.lhs);
-              if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
-                      assign.rhs)) {
-                fir::factory::disassociateMutableBox(*builder, loc, lhs);
-                return;
-              }
-              // Do not generate a temp in case rhs is an array section.
-              fir::ExtendedValue rhs =
-                  Fortran::lower::isArraySectionWithoutVectorSubscript(
-                      assign.rhs)
-                      ? Fortran::lower::createSomeArrayBox(
-                            *this, assign.rhs, localSymbols, stmtCtx)
-                      : genExprAddr(assign.rhs, stmtCtx);
-              fir::factory::associateMutableBoxWithRemap(*builder, loc, lhs,
-                                                         rhs, lbounds, ubounds);
-              if (explicitIterationSpace()) {
-                mlir::ValueRange inners = explicitIterSpace.getInnerArgs();
-                if (!inners.empty())
-                  builder->create<fir::ResultOp>(loc, inners);
-              }
+              return genPointerAssignment(loc, assign, boundExprs);
             },
         },
         assign.u);
     if (explicitIterationSpace())
       Fortran::lower::createArrayMergeStores(*this, explicitIterSpace);
   }
 
   void genFIR(const Fortran::parser::WhereConstruct &c) {
void addMaskVariable(Fortran::lower::FrontEndExpr exp) {
     explicitIterSpace.outermostContext().attachCleanup(
         [builder = this->builder, hdr, loc]() {
           fir::runtime::genRaggedArrayDeallocate(loc, *builder, hdr);
         });
   }
 
   void createRuntimeTypeInfoGlobals() {}
 
+  bool lowerToHighLevelFIR() const {
+    return bridge.getLoweringOptions().getLowerToHighLevelFIR();
+  }
+
   //===--------------------------------------------------------------------===//
 
   Fortran::lower::LoweringBridge &bridge;
   Fortran::evaluate::FoldingContext foldingContext;
   fir::FirOpBuilder *builder = nullptr;
   Fortran::lower::pft::Evaluation *evalPtr = nullptr;
   Fortran::lower::SymMap localSymbols;
   Fortran::parser::CharBlock currentPosition;

flang/lib/Lower/ConvertCall.cpp

for (auto arg : llvm::enumerate(loweredActuals)) {
     // Ad-hoc argument lowering handling.
     Fortran::lower::ArgLoweringRule argRules =
         Fortran::lower::lowerIntrinsicArgumentAs(*argLowering, arg.index());
     switch (argRules.lowerAs) {
     case Fortran::lower::LowerIntrinsicArgAs::Value:
       operands.emplace_back(
           Fortran::lower::convertToValue(loc, converter, actual, stmtCtx));
       continue;
-    case Fortran::lower::LowerIntrinsicArgAs::Addr: {
-      const auto *argExpr = callContext.procRef.UnwrapArgExpr(arg.index());
-      bool isSimplyContiguous =
-          actual.isScalar() ||
-          (argExpr && Fortran::evaluate::IsSimplyContiguous(
-                          *argExpr, converter.getFoldingContext()));
-      operands.emplace_back(Fortran::lower::convertToAddress(
-          loc, converter, actual, isSimplyContiguous, stmtCtx));
+    case Fortran::lower::LowerIntrinsicArgAs::Addr:
+      operands.emplace_back(
+          Fortran::lower::convertToAddress(loc, converter, actual, stmtCtx));
       continue;
-    }
     case Fortran::lower::LowerIntrinsicArgAs::Box:
       operands.emplace_back(
           Fortran::lower::convertToBox(loc, converter, actual, stmtCtx));
       continue;
     case Fortran::lower::LowerIntrinsicArgAs::Inquired:
       TODO(loc, "as inquired arguments in HLFIR");
       continue;
     }

flang/lib/Lower/ConvertExprToHLFIR.cpp

fir::BoxValue Fortran::lower::convertExprToBox(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
     Fortran::lower::StatementContext &stmtCtx) {
   hlfir::EntityWithAttributes loweredExpr =
       HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
   return convertToBox(loc, converter, loweredExpr, stmtCtx);
 }
 
-fir::ExtendedValue
-Fortran::lower::convertToAddress(mlir::Location loc,
-                                 Fortran::lower::AbstractConverter &converter,
-                                 hlfir::Entity entity, bool isSimplyContiguous,
-                                 Fortran::lower::StatementContext &stmtCtx) {
-  if (!isSimplyContiguous)
-    TODO(loc, "genExprAddr of non contiguous variables in HLFIR");
-  fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue(
-      loc, converter.getFirOpBuilder(), entity, stmtCtx);
+fir::ExtendedValue Fortran::lower::convertToAddress(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
+  fir::ExtendedValue exv =
+      Fortran::lower::translateToExtendedValue(loc, builder, entity, stmtCtx);
   if (fir::isa_trivial(fir::getBase(exv).getType()))
     TODO(loc, "place trivial in memory");
-  if (const auto *mutableBox = exv.getBoxOf<fir::MutableBoxValue>())
-    exv = fir::factory::genMutableBoxRead(converter.getFirOpBuilder(), loc,
-                                          *mutableBox);
   return exv;
 }
 fir::ExtendedValue Fortran::lower::convertExprToAddress(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
     Fortran::lower::StatementContext &stmtCtx) {
   hlfir::EntityWithAttributes loweredExpr =
       HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
-  bool isSimplyContiguous =
-      expr.Rank() == 0 || Fortran::evaluate::IsSimplyContiguous(
-                              expr, converter.getFoldingContext());
-  return convertToAddress(loc, converter, loweredExpr, isSimplyContiguous,
-                          stmtCtx);
+  return convertToAddress(loc, converter, loweredExpr, stmtCtx);
 }
 
 fir::ExtendedValue Fortran::lower::convertToValue(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx) {
   auto &builder = converter.getFirOpBuilder();
   fir::ExtendedValue exv =
       Fortran::lower::translateToExtendedValue(loc, builder, entity, stmtCtx);

 fir::ExtendedValue Fortran::lower::convertExprToValue(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
     Fortran::lower::StatementContext &stmtCtx) {
   hlfir::EntityWithAttributes loweredExpr =
       HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
   return convertToValue(loc, converter, loweredExpr, stmtCtx);
 }
+
+fir::MutableBoxValue Fortran::lower::convertExprToMutableBox(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap) {
+  // Pointers and Allocatable cannot be temporary expressions. Temporaries may
+  // be created while lowering it (e.g. if any indices expression of a
+  // designator create temporaries), but they can be destroyed before using the
+  // lowered pointer or allocatable;
+  Fortran::lower::StatementContext localStmtCtx;
+  hlfir::EntityWithAttributes loweredExpr =
+      HlfirBuilder(loc, converter, symMap, localStmtCtx).gen(expr);
+  fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue(
+      loc, converter.getFirOpBuilder(), loweredExpr, localStmtCtx);
+  auto *mutableBox = exv.getBoxOf<fir::MutableBoxValue>();
+  assert(mutableBox && "expression could not be lowered to mutable box");
+  return *mutableBox;
+}

flang/test/Lower/HLFIR/allocatable-and-pointer-status-change.f90

+! Test lowering of allocate, deallocate and pointer assignment statements to
+! HLFIR.
+! RUN: bbc -emit-fir -hlfir -o - %s -I nw | FileCheck %s
+
+subroutine allocation(x)
+  character(*), allocatable :: x(:)
+! CHECK-LABEL: func.func @_QPallocation(
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] typeparams %[[VAL_2:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>,  {{.*}}Ex
+  deallocate(x)
+! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
+! CHECK:  %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>>
+! CHECK:  fir.freemem %[[VAL_5]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
+! CHECK:  %[[VAL_6:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1,?>>>
+! CHECK:  %[[VAL_7:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_8:.*]] = fir.shape %[[VAL_7]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_9:.*]] = fir.embox %[[VAL_6]](%[[VAL_8]]) typeparams %[[VAL_2]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>
+  allocate(x(100))
+! CHECK:  %[[VAL_10:.*]] = arith.constant 100 : i32
+! CHECK:  %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i32) -> index
+! CHECK:  %[[VAL_12:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_13:.*]] = arith.cmpi sgt, %[[VAL_11]], %[[VAL_12]] : index
+! CHECK:  %[[VAL_14:.*]] = arith.select %[[VAL_13]], %[[VAL_11]], %[[VAL_12]] : index
+! CHECK:  %[[VAL_15:.*]] = fir.allocmem !fir.array<?x!fir.char<1,?>>(%[[VAL_2]] : index), %[[VAL_14]] {uniq_name = "_QFallocationEx.alloc"}
+! CHECK:  %[[VAL_16:.*]] = fir.shape %[[VAL_14]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_17:.*]] = fir.embox %[[VAL_15]](%[[VAL_16]]) typeparams %[[VAL_2]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>
+! CHECK:  fir.store %[[VAL_17]] to %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
+end subroutine
+
+subroutine pointer_assignment(p, ziel)
+  real, pointer :: p(:)
+  real, target :: ziel(42:)
+! CHECK-LABEL: func.func @_QPpointer_assignment(
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>,  {{.*}}Ep
+! CHECK:  %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_5:[a-z0-9]*]]) {fortran_attrs = #fir.var_attrs<target>,  {{.*}}Eziel
+  p => ziel
+! CHECK:  %[[VAL_7:.*]] = fir.shift %[[VAL_4:.*]] : (index) -> !fir.shift<1>
+! CHECK:  %[[VAL_8:.*]] = fir.rebox %[[VAL_6]]#1(%[[VAL_7]]) : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK:  fir.store %[[VAL_8]] to %[[VAL_2]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+  p => ziel(42:77:3)
+! CHECK:  %[[VAL_14:.*]] = hlfir.designate %{{.*}}#0 (%{{.*}}:%{{.*}}:%{{.*}})  shape %{{.*}} : (!fir.box<!fir.array<?xf32>>, index, index, index, !fir.shape<1>) -> !fir.box<!fir.array<12xf32>>
+! CHECK:  %[[VAL_15:.*]] = fir.rebox %[[VAL_14]] : (!fir.box<!fir.array<12xf32>>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK:  fir.store %[[VAL_15]] to %[[VAL_2]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+end subroutine
+
+subroutine pointer_remapping(p, ziel)
+  real, pointer :: p(:, :)
+  real, target :: ziel(10, 20, 30)
+! CHECK-LABEL: func.func @_QPpointer_remapping(
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>,  {{.*}}Ep
+! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_6:[a-z0-9]*]]) {fortran_attrs = #fir.var_attrs<target>,  {{.*}}Eziel
+  p(2:7, 3:102) => ziel
+! CHECK:  %[[VAL_8:.*]] = arith.constant 2 : i64
+! CHECK:  %[[VAL_9:.*]] = arith.constant 7 : i64
+! CHECK:  %[[VAL_10:.*]] = arith.constant 3 : i64
+! CHECK:  %[[VAL_11:.*]] = arith.constant 102 : i64
+! CHECK:  %[[VAL_12:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_13:.*]] = fir.convert %[[VAL_8]] : (i64) -> index
+! CHECK:  %[[VAL_14:.*]] = fir.convert %[[VAL_9]] : (i64) -> index
+! CHECK:  %[[VAL_15:.*]] = arith.subi %[[VAL_14]], %[[VAL_13]] : index
+! CHECK:  %[[VAL_16:.*]] = arith.addi %[[VAL_15]], %[[VAL_12]] : index
+! CHECK:  %[[VAL_17:.*]] = fir.convert %[[VAL_10]] : (i64) -> index
+! CHECK:  %[[VAL_18:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
+! CHECK:  %[[VAL_19:.*]] = arith.subi %[[VAL_18]], %[[VAL_17]] : index
+! CHECK:  %[[VAL_20:.*]] = arith.addi %[[VAL_19]], %[[VAL_12]] : index
+! CHECK:  %[[VAL_21:.*]] = fir.convert %[[VAL_7]]#1 : (!fir.ref<!fir.array<10x20x30xf32>>) -> !fir.ref<!fir.array<?x?xf32>>
+! CHECK:  %[[VAL_22:.*]] = fir.shape_shift %[[VAL_8]], %[[VAL_16]], %[[VAL_10]], %[[VAL_20]] : (i64, index, i64, index) -> !fir.shapeshift<2>
+! CHECK:  %[[VAL_23:.*]] = fir.embox %[[VAL_21]](%[[VAL_22]]) : (!fir.ref<!fir.array<?x?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+! CHECK:  fir.store %[[VAL_23]] to %[[VAL_2]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+end subroutine
+
+subroutine alloc_comp(x)
+  type t
+     real, allocatable :: a(:)
+  end type
+  type(t) :: x(10)
+! CHECK-LABEL: func.func @_QPalloc_comp(
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_2:[a-z0-9]*]]) {{.*}}Ex
+  allocate(x(10_8)%a(100_8))
+! CHECK:  %[[VAL_4:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_5:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_4]])  : (!fir.ref<!fir.array<10x!fir.type<_QFalloc_compTt{a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>, index) -> !fir.ref<!fir.type<_QFalloc_compTt{a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>
+! CHECK:  %[[VAL_6:.*]] = hlfir.designate %[[VAL_5]]{"a"}   {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QFalloc_compTt{a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+! CHECK:  %[[VAL_7:.*]] = arith.constant 100 : i64
+! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
+! CHECK:  %[[VAL_9:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_10:.*]] = arith.cmpi sgt, %[[VAL_8]], %[[VAL_9]] : index
+! CHECK:  %[[VAL_11:.*]] = arith.select %[[VAL_10]], %[[VAL_8]], %[[VAL_9]] : index
+! CHECK:  %[[VAL_12:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_11]] {uniq_name = "_QEa.alloc"}
+! CHECK:  %[[VAL_13:.*]] = fir.shape %[[VAL_11]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_14:.*]] = fir.embox %[[VAL_12]](%[[VAL_13]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xf32>>>
+! CHECK:  fir.store %[[VAL_14]] to %[[VAL_6]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+end subroutine
+
+subroutine ptr_comp_assign(x, ziel)
+  type t
+     real, pointer :: p(:)
+  end type
+  type(t) :: x(10)
+! CHECK-LABEL: func.func @_QPptr_comp_assign(
+! CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_3:[a-z0-9]*]]) {{.*}}Ex
+  real, target :: ziel(100)
+  x(9_8)%p => ziel
+! CHECK:  %[[VAL_5:.*]] = arith.constant 100 : index
+! CHECK:  %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_6:[a-z0-9]*]]) {fortran_attrs = #fir.var_attrs<target>,  {{.*}}Eziel
+! CHECK:  %[[VAL_8:.*]] = arith.constant 9 : index
+! CHECK:  %[[VAL_9:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_8]])  : (!fir.ref<!fir.array<10x!fir.type<_QFptr_comp_assignTt{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>, index) -> !fir.ref<!fir.type<_QFptr_comp_assignTt{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>
+! CHECK:  %[[VAL_10:.*]] = hlfir.designate %[[VAL_9]]{"p"}   {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QFptr_comp_assignTt{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:  %[[VAL_11:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_12:.*]] = fir.embox %[[VAL_7]]#1(%[[VAL_11]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK:  fir.store %[[VAL_12]] to %[[VAL_10]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+end subroutine