Regroup all emboxing boilerplate in FirOpBuilder::createBox

Author: jeanPerier

flang/include/flang/Lower/CharacterExpr.h

@@ -104,6 +104,10 @@ class CharacterExprHelper {
   /// - fir.array<len x fir.char<kind>>
   static bool isCharacterScalar(mlir::Type type);
 
+  /// Does this extended value holds a !fir.array<len x ... fir.char<kind>>
+  /// where len is not the unknown extent ?
+  static bool hasConstantLengthInType(const fir::ExtendedValue &);
+
   /// Extract the kind of a character type
   static fir::KindTy getCharacterKind(mlir::Type type);
 

flang/include/flang/Lower/FIRBuilder.h

@@ -210,6 +210,13 @@ class FirOpBuilder : public mlir::OpBuilder {
   /// Create one of the shape ops given an extended value.
   mlir::Value createShape(mlir::Location loc, const fir::ExtendedValue &exv);
 
+  /// Create a boxed value (Fortran descriptor) to be passed to the runtime.
+  /// \p exv is an extended value holding a memory reference to the object that
+  /// must be boxed. This function will crash if provided something that is not
+  /// a memory reference type.
+  /// Array entities are boxed with a shape and character with their length.
+  mlir::Value createBox(mlir::Location loc, const fir::ExtendedValue &exv);
+
 private:
   const fir::KindMapping &kindMap;
 };

flang/lib/Lower/CharacterExpr.cpp

@@ -632,3 +632,20 @@ Fortran::lower::CharacterExprHelper::readLengthFromBox(mlir::Value box) {
   }
   return size;
 }
+
+bool Fortran::lower::CharacterExprHelper::hasConstantLengthInType(
+    const fir::ExtendedValue &exv) {
+  auto type = fir::getBase(exv).getType();
+  if (auto boxTy = type.dyn_cast<fir::BoxType>())
+    type = boxTy.getEleTy();
+  if (auto eleTy = fir::dyn_cast_ptrEleTy(type))
+    type = eleTy;
+  if (auto seqTy = type.dyn_cast<fir::SequenceType>()) {
+    assert(seqTy.getEleTy().isa<fir::CharacterType>() &&
+           "entity is not a character");
+    assert(seqTy.getShape().size() > 0 && "character has empty shape");
+    auto lenVal = seqTy.getShape()[0];
+    return lenVal != fir::SequenceType::getUnknownExtent();
+  }
+  return false;
+}

flang/lib/Lower/FIRBuilder.cpp

@@ -9,6 +9,7 @@
 #include "flang/Lower/FIRBuilder.h"
 #include "SymbolMap.h"
 #include "flang/Lower/Bridge.h"
+#include "flang/Lower/CharacterExpr.h"
 #include "flang/Lower/ComplexExpr.h"
 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/Support/BoxValue.h"
@@ -204,7 +205,7 @@ Fortran::lower::FirOpBuilder::createShape(mlir::Location loc,
     auto shapeTy =
         fir::ShapeShiftType::get(getContext(), box.getExtents().size());
     llvm::SmallVector<mlir::Value, 8> pairs;
-    for (auto [fst,snd] : llvm::zip(box.getLBounds(), box.getExtents())) {
+    for (auto [fst, snd] : llvm::zip(box.getLBounds(), box.getExtents())) {
       pairs.push_back(createConvert(loc, idxTy, fst));
       pairs.push_back(createConvert(loc, idxTy, snd));
     }
@@ -219,3 +220,44 @@ Fortran::lower::FirOpBuilder::createShape(mlir::Location loc,
                      return mlir::Value{};
                    });
 }
+
+mlir::Value
+Fortran::lower::FirOpBuilder::createBox(mlir::Location loc,
+                                        const fir::ExtendedValue &exv) {
+  auto itemAddr = fir::getBase(exv);
+  auto elementType = fir::dyn_cast_ptrEleTy(itemAddr.getType());
+  if (!elementType)
+    mlir::emitError(loc, "internal: expected a memory reference type ")
+        << itemAddr.getType();
+  auto boxTy = fir::BoxType::get(elementType);
+  return exv.match(
+      [&](const fir::ArrayBoxValue &box) -> mlir::Value {
+        auto s = createShape(loc, exv);
+        return create<fir::EmboxOp>(loc, boxTy, itemAddr, s);
+      },
+      [&](const fir::CharArrayBoxValue &box) -> mlir::Value {
+        auto s = createShape(loc, exv);
+        if (Fortran::lower::CharacterExprHelper::hasConstantLengthInType(exv))
+          return create<fir::EmboxOp>(loc, boxTy, itemAddr, s);
+
+        mlir::Value emptySlice;
+        llvm::SmallVector<mlir::Value, 1> lenParams{box.getLen()};
+        return create<fir::EmboxOp>(loc, boxTy, itemAddr, s, emptySlice,
+                                    lenParams);
+      },
+      [&](const fir::BoxValue &box) -> mlir::Value {
+        auto s = createShape(loc, exv);
+        return create<fir::EmboxOp>(loc, boxTy, itemAddr, s);
+      },
+      [&](const fir::CharBoxValue &box) -> mlir::Value {
+        if (Fortran::lower::CharacterExprHelper::hasConstantLengthInType(exv))
+          return create<fir::EmboxOp>(loc, boxTy, itemAddr);
+        mlir::Value emptyShape, emptySlice;
+        llvm::SmallVector<mlir::Value, 1> lenParams{box.getLen()};
+        return create<fir::EmboxOp>(loc, boxTy, itemAddr, emptyShape,
+                                    emptySlice, lenParams);
+      },
+      [&](const auto &) -> mlir::Value {
+        return create<fir::EmboxOp>(loc, boxTy, itemAddr);
+      });
+}

flang/test/Lower/io-item-list.f90

@@ -0,0 +1,27 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test that IO item list
+
+! FIXME: embox does not like getting a length when it gets
+! a !fir.ref<!fir.char<kind>> buffer. Either the verifier
+! should be relaxed, or we should finish up ensuring character
+! type for such buffer are !fir.ref<fir.array<?x!fir.char<kind>>>
+!
+!subroutine pass_assumed_len_char(c)
+!  character(*) :: c
+!  write(1, rec=1) c
+!end
+
+! CHECK-LABEL: func @_QPpass_assumed_len_char_array 
+subroutine pass_assumed_len_char_array(carray)
+  character(*) :: carray(2, 3)
+  ! CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1>>, index)
+  ! CHECK-DAG: %[[buffer:.*]] = fir.convert %[[unboxed]]#0 : (!fir.ref<!fir.char<1>>) -> !fir.ref<!fir.array<?x2x3x!fir.char<1>>>
+  ! CHECK-DAG: %[[c2:.*]] = constant 2 : index
+  ! CHECK-DAG: %[[c3:.*]] = constant 3 : index
+  ! CHECK-DAG: %[[shape:.*]] = fir.shape %[[c2]], %[[c3]] : (index, index) -> !fir.shape<2>
+  ! CHECK: %[[box:.*]] = fir.embox %[[buffer]](%[[shape]]) typeparams %[[unboxed]]#1 : (!fir.ref<!fir.array<?x2x3x!fir.char<1>>>, !fir.shape<2>, index) -> !fir.box<!fir.array<?x2x3x!fir.char<1>>>
+  ! CHECK: %[[descriptor:.*]] = fir.convert %[[box]] : (!fir.box<!fir.array<?x2x3x!fir.char<1>>>) -> !fir.box<none>
+  ! CHECK: fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[descriptor]]) : (!fir.ref<i8>, !fir.box<none>) -> i1
+  print *, carray
+end