Fix n2f.f90.

Rewrite filter.
Add another raiseBaseType method.

Author: schweitzpgi

flang/include/flang/Lower/ConvertExpr.h

@@ -60,9 +60,9 @@ createSomeExtendedAddress(mlir::Location loc, AbstractConverter &converter,
 /// Create the address of the box.
 /// \p expr must be the designator of an allocatable/pointer entity.
 fir::MutableBoxValue
-createSomeMutableBox(mlir::Location loc, AbstractConverter &converter,
-                     const evaluate::Expr<evaluate::SomeType> &expr,
-                     SymMap &symMap);
+createMutableBox(mlir::Location loc, AbstractConverter &converter,
+                 const evaluate::Expr<evaluate::SomeType> &expr,
+                 SymMap &symMap);
 
 /// Lower an array assignment expression.
 ///
@@ -138,7 +138,8 @@ void createAnyMaskedArrayAssignment(
 /// it is not allocated yet or reallocation it if it does not conform
 /// with the right hand side.
 void createAllocatableArrayAssignment(
-    AbstractConverter &converter, const fir::MutableBoxValue &lhs,
+    AbstractConverter &converter,
+    const evaluate::Expr<evaluate::SomeType> &lhs,
     const evaluate::Expr<evaluate::SomeType> &rhs,
     ExplicitIterSpace &explicitIterSpace, ImplicitIterSpace &implicitIterSpace,
     SymMap &symMap, StatementContext &stmtCtx);

flang/lib/Lower/Bridge.cpp

@@ -315,7 +315,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
   fir::MutableBoxValue
   genExprMutableBox(mlir::Location loc,
                     const Fortran::lower::SomeExpr &expr) override final {
-    return createSomeMutableBox(loc, *this, expr, localSymbols);
+    return createMutableBox(loc, *this, expr, localSymbols);
   }
   fir::ExtendedValue genExprBox(const Fortran::lower::SomeExpr &expr,
                                 Fortran::lower::StatementContext &context,
@@ -1703,9 +1703,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     if (isWholeAllocatable(assign.lhs)) {
       // Assignment to allocatables may require the lhs to be
       // deallocated/reallocated. See Fortran 2018 10.2.1.3 p3
-      auto lhs = genExprMutableBox(toLocation(), assign.lhs);
       Fortran::lower::createAllocatableArrayAssignment(
-          *this, lhs, assign.rhs, explicitIterSpace, implicitIterSpace,
+          *this, assign.lhs, assign.rhs, explicitIterSpace, implicitIterSpace,
           localSymbols, stmtCtx);
       return;
     }

flang/lib/Lower/ConvertExpr.cpp

@@ -2404,6 +2404,19 @@ class ArrayExprLowering {
       return result;
     }
 
+    /// In an explicit space, the context may include an implicit subspace. The
+    /// RHS of the assignment does not necessarily have rank and can be promoted
+    /// from a scalar to an array. In that case, the implicit subscripts must be
+    /// removed.
+    void removeImplicit() {
+      llvm::SmallVector<AccessValue> newIndices;
+      const auto size = indices.size();
+      for (std::remove_const_t<decltype(size)> i = 0, j = 0; j < size; ++j)
+        if (indices[j].access() != AccessKind::Implicit)
+          newIndices[i++] = indices[j];
+      indices.swap(newIndices);
+    }
+
   private:
     mlir::Value inArg;
     mlir::Value outRes;
@@ -2480,8 +2493,10 @@ class ArrayExprLowering {
     auto lambda = [=](IterSpace iters) -> ExtValue {
       auto innerArg = iters.innerArgument();
       auto resTy = adjustedArrayElementType(innerArg.getType());
+      auto cast = builder.createConvert(loc, fir::unwrapSequenceType(resTy),
+                                        iters.getElement());
       auto arrUpdate = builder.create<fir::ArrayUpdateOp>(
-          loc, resTy, innerArg, iters.getElement(), iters.iterVec(),
+          loc, resTy, innerArg, cast, iters.iterVec(),
           destination.typeparams());
       return abstractArrayExtValue(arrUpdate);
     };
@@ -2530,7 +2545,7 @@ class ArrayExprLowering {
   static void lowerAllocatableArrayAssignment(
       Fortran::lower::AbstractConverter &converter,
       Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
-      const fir::MutableBoxValue &lhs,
+      const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &lhs,
       const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &rhs,
       Fortran::lower::ExplicitIterSpace &explicitSpace,
       Fortran::lower::ImplicitIterSpace &implicitSpace) {
@@ -2546,11 +2561,15 @@ class ArrayExprLowering {
   /// defines the iteration space of the computation and the lhs is
   /// resized/reallocated to fit if necessary.
   void lowerAllocatableArrayAssignment(
-      const fir::MutableBoxValue &mutableBox,
+      const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &lhs,
       const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &rhs) {
     // With assignment to allocatable, we want to lower the rhs first and use
     // its shape to determine if we need to reallocate, etc.
     auto loc = getLoc();
+    // FIXME: If the lhs is in an explicit iteration space, the assignment may
+    // be to an array of allocatable arrays rather than a single allocatable
+    // array.
+    auto mutableBox = createMutableBox(loc, converter, lhs, symMap);
     auto resultTy = converter.genType(rhs);
     auto rhsCC = [&]() {
       PushSemantics(ConstituentSemantics::RefTransparent);
@@ -2738,8 +2757,11 @@ class ArrayExprLowering {
       const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &exp) {
     auto resTy = explicitSpace ? destination->getResult(0).getType()
                                : converter.genType(exp);
+    bool explicitScalar = explicitSpace && exp.Rank() == 0;
     return std::visit(
-        [&](const auto &e) { return lowerArrayExpression(genarr(e), resTy); },
+        [&](const auto &e) {
+          return lowerArrayExpression(genarr(e), resTy, explicitScalar);
+        },
         exp.u);
   }
   ExtValue lowerArrayExpression(const ExtValue &exv) {
@@ -2766,11 +2788,15 @@ class ArrayExprLowering {
   /// Otherwise, \p resultTy is ignored and the expression is evaluated
   /// in the destination. \p f is a continuation built from an
   /// evaluate::Expr or an ExtendedValue.
-  ExtValue lowerArrayExpression(CC f, mlir::Type resultTy) {
+  ExtValue lowerArrayExpression(CC f, mlir::Type resultTy,
+                                bool explicitScalar = false) {
     auto loc = getLoc();
     auto [iterSpace, insPt] = genIterSpace(resultTy);
+    auto rhsIterSpace = iterSpace;
+    if (explicitScalar)
+      rhsIterSpace.removeImplicit();
     auto innerArg = iterSpace.innerArgument();
-    auto exv = f(iterSpace);
+    auto exv = f(rhsIterSpace);
     mlir::Value upd;
     if (ccDest.hasValue()) {
       auto element = fir::getBase(exv);
@@ -3212,17 +3238,21 @@ class ArrayExprLowering {
       const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &e) {
     struct Filter : public Fortran::evaluate::AnyTraverse<
                         Filter, std::optional<llvm::SmallVector<mlir::Value>>> {
-      using Base = Fortran::evaluate::AnyTraverse<
-          Filter, std::optional<llvm::SmallVector<mlir::Value>>>;
+      using RT = std::optional<llvm::SmallVector<mlir::Value>>;
+      using Base = Fortran::evaluate::AnyTraverse<Filter, RT>;
       using Base::operator();
 
-      Filter(const llvm::SmallVector<mlir::Value> init)
-          : Base(*this), bounds(init) {}
+      Filter(ArrayExprLowering *const ael) : Base(*this), ael(ael) {}
 
-      std::optional<llvm::SmallVector<mlir::Value>>
-      operator()(const Fortran::evaluate::ArrayRef &ref) {
+      RT operator()(const Fortran::evaluate::ArrayRef &ref) {
         if ((ref.base().IsSymbol() || ref.base().Rank() == 0) &&
             ref.Rank() > 0 && !ref.subscript().empty()) {
+          auto baseTy = ael->raiseBaseType(ref.base());
+          auto ty = ref.base().IsSymbol()
+                        ? baseTy
+                        : baseTy.cast<fir::RecordType>().getType(
+                              toStringRef(ref.GetLastSymbol().name()));
+          auto bounds = ael->getShape(ty);
           assert(ref.subscript().size() == bounds.size());
           llvm::SmallVector<mlir::Value> result;
           auto bdIter = bounds.begin();
@@ -3242,15 +3272,24 @@ class ArrayExprLowering {
         }
         return {};
       }
+      RT operator()(const Fortran::evaluate::Component &cpnt) {
+        if (cpnt.base().Rank() == 0 && cpnt.Rank() > 0)
+          return ael->getShape(ael->raiseBaseType(cpnt));
+        return {};
+      }
+      RT operator()(const Fortran::semantics::Symbol &sym) {
+        if (sym.Rank() > 0)
+          return ael->getShape(ael->raiseBaseType(sym));
+        return {};
+      }
 
-      llvm::SmallVector<mlir::Value> bounds;
+      ArrayExprLowering *const ael;
     };
 
-    auto originalShape = getShape(converter.genType(e));
-    Filter filter(originalShape);
+    Filter filter(this);
     if (auto res = filter(e))
       return *res;
-    return originalShape;
+    return {};
   }
 
   void genMasks() {
@@ -4308,6 +4347,10 @@ class ArrayExprLowering {
     return false;
   }
 
+  /// Set of helper member functions for generating the type of a particular
+  /// component along a path. We cannot use the `converter` here because it is
+  /// not possible to uplift an arbitrary component list to a generic
+  /// `Fortran::evaluate::Expr`.
   mlir::Type raiseBaseType(const Fortran::evaluate::Component &x) {
     auto baseTy = raiseBaseType(x.base());
     auto recTy = baseTy.cast<fir::RecordType>();
@@ -4320,10 +4363,13 @@ class ArrayExprLowering {
     LLVM_DEBUG(llvm::dbgs() << "base type s " << rv << '\n');
     return rv;
   }
+  mlir::Type raiseBaseType(const Fortran::evaluate::NamedEntity &n) {
+    return n.IsSymbol() ? raiseBaseType(n.GetLastSymbol())
+                        : raiseBaseType(n.GetComponent());
+  }
   mlir::Type raiseBaseType(const Fortran::evaluate::ArrayRef &x) {
     auto &base = x.base();
-    mlir::Type baseTy = base.IsSymbol() ? raiseBaseType(base.GetLastSymbol())
-                                        : raiseBaseType(base.GetComponent());
+    mlir::Type baseTy = raiseBaseType(base);
     auto seqTy = baseTy.cast<fir::SequenceType>();
     auto rv = seqTy.getEleTy();
     LLVM_DEBUG(llvm::dbgs() << "base type a " << rv << '\n');
@@ -5700,12 +5746,12 @@ void Fortran::lower::createAnyMaskedArrayAssignment(
 
 void Fortran::lower::createAllocatableArrayAssignment(
     Fortran::lower::AbstractConverter &converter,
-    const fir::MutableBoxValue &lhs,
+    const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &lhs,
     const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &rhs,
     Fortran::lower::ExplicitIterSpace &explicitSpace,
     Fortran::lower::ImplicitIterSpace &implicitSpace,
     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
-  LLVM_DEBUG(llvm::dbgs() << "defining array: " << lhs << '\n';
+  LLVM_DEBUG(lhs.AsFortran(llvm::dbgs() << "defining array: ") << '\n';
              rhs.AsFortran(llvm::dbgs() << "assign expression: ")
              << " given the explicit iteration space:\n"
              << explicitSpace << "\n and implied mask conditions:\n"
@@ -5733,7 +5779,7 @@ fir::ExtendedValue Fortran::lower::createSomeArrayBox(
                                                       stmtCtx, expr);
 }
 
-fir::MutableBoxValue Fortran::lower::createSomeMutableBox(
+fir::MutableBoxValue Fortran::lower::createMutableBox(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &expr,
     Fortran::lower::SymMap &symMap) {