[flang-commits] [flang] a02f750 - [flang] Create a box instead of a temp to write to a char array

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2022-09-05T13:29:21+02:00
New Revision: a02f7505751eb2b13ba2d8d62ca897d1aaf9d0f0

URL: https://github.com/llvm/llvm-project/commit/a02f7505751eb2b13ba2d8d62ca897d1aaf9d0f0
DIFF: https://github.com/llvm/llvm-project/commit/a02f7505751eb2b13ba2d8d62ca897d1aaf9d0f0.diff

LOG: [flang] Create a box instead of a temp to write to a char array

Reviewed By: jeanPerier

Differential Revision: https://reviews.llvm.org/D133284

Added: 
    flang/test/Lower/io-char-array.f90

Modified: 
    flang/lib/Lower/IO.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 00fa17e4508dc..14642146df015 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -1315,11 +1315,11 @@ constexpr bool isDataTransferInternal<Fortran::parser::PrintStmt>(
 /// (normally 1), then a descriptor is required by the runtime IO API. This
 /// condition holds even in F77 sources.
 static llvm::Optional<fir::ExtendedValue> getVariableBufferRequiredDescriptor(
-    Fortran::lower::AbstractConverter &converter,
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
     const Fortran::parser::Variable &var,
     Fortran::lower::StatementContext &stmtCtx) {
   fir::ExtendedValue varBox =
-      converter.genExprAddr(var.typedExpr->v.value(), stmtCtx);
+      converter.genExprBox(loc, var.typedExpr->v.value(), stmtCtx);
   fir::KindTy defCharKind = converter.getKindMap().defaultCharacterKind();
   mlir::Value varAddr = fir::getBase(varBox);
   if (fir::factory::CharacterExprHelper::getCharacterOrSequenceKind(
@@ -1333,21 +1333,21 @@ static llvm::Optional<fir::ExtendedValue> getVariableBufferRequiredDescriptor(
 template <typename A>
 static llvm::Optional<fir::ExtendedValue>
 maybeGetInternalIODescriptor(Fortran::lower::AbstractConverter &converter,
-                             const A &stmt,
+                             mlir::Location loc, const A &stmt,
                              Fortran::lower::StatementContext &stmtCtx) {
   if (stmt.iounit.has_value())
     if (auto *var = std::get_if<Fortran::parser::Variable>(&stmt.iounit->u))
-      return getVariableBufferRequiredDescriptor(converter, *var, stmtCtx);
+      return getVariableBufferRequiredDescriptor(converter, loc, *var, stmtCtx);
   if (auto *unit = getIOControl<Fortran::parser::IoUnit>(stmt))
     if (auto *var = std::get_if<Fortran::parser::Variable>(&unit->u))
-      return getVariableBufferRequiredDescriptor(converter, *var, stmtCtx);
+      return getVariableBufferRequiredDescriptor(converter, loc, *var, stmtCtx);
   return llvm::None;
 }
 template <>
 inline llvm::Optional<fir::ExtendedValue>
 maybeGetInternalIODescriptor<Fortran::parser::PrintStmt>(
-    Fortran::lower::AbstractConverter &, const Fortran::parser::PrintStmt &,
-    Fortran::lower::StatementContext &) {
+    Fortran::lower::AbstractConverter &, mlir::Location loc,
+    const Fortran::parser::PrintStmt &, Fortran::lower::StatementContext &) {
   return llvm::None;
 }
 
@@ -1933,7 +1933,7 @@ genDataTransferStmt(Fortran::lower::AbstractConverter &converter,
   const bool isList = isFormatted ? isDataTransferList(stmt) : false;
   const bool isInternal = isDataTransferInternal(stmt);
   llvm::Optional<fir::ExtendedValue> descRef =
-      isInternal ? maybeGetInternalIODescriptor(converter, stmt, stmtCtx)
+      isInternal ? maybeGetInternalIODescriptor(converter, loc, stmt, stmtCtx)
                  : llvm::None;
   const bool isInternalWithDesc = descRef.has_value();
   const bool isAsync = isDataTransferAsynchronous(loc, stmt);

diff  --git a/flang/test/Lower/io-char-array.f90 b/flang/test/Lower/io-char-array.f90
new file mode 100644
index 0000000000000..e2ce6d7edeb65
--- /dev/null
+++ b/flang/test/Lower/io-char-array.f90
@@ -0,0 +1,27 @@
+! Check that a box is created instead of a temp to write to a char array.
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+subroutine io_char_array
+  character(12) :: r(2) = 'badbadbadbad'
+  write(r(1:2),8)
+  print *, r
+1 format((1X,A))
+8 format("new"/"data")
+end subroutine
+
+! CHECK-LABEL: func.func @_QPio_char_array()
+! CHECK: %[[R:.*]] = fir.address_of(@_QFio_char_arrayEr) : !fir.ref<!fir.array<2x!fir.char<1,12>>>
+! CHECK: %[[C2_SHAPE:.*]] = arith.constant 2 : index
+! CHECK: %[[C1_I64_0:.*]] = arith.constant 1 : i64
+! CHECK: %[[C1_IDX_0:.*]] = fir.convert %[[C1_I64_0]] : (i64) -> index
+! CHECK: %[[C1_I64_1:.*]] = arith.constant 1 : i64
+! CHECK: %[[C1_IDX_1:.*]] = fir.convert %[[C1_I64_1]] : (i64) -> index
+! CHECK: %[[C2_I64:.*]] = arith.constant 2 : i64
+! CHECK: %[[C2_IDX:.*]] = fir.convert %[[C2_I64]] : (i64) -> index
+! CHECK: %[[SHAPE:.*]] = fir.shape %[[C2_SHAPE]] : (index) -> !fir.shape<1>
+! CHECK: %[[SLICE:.*]] = fir.slice %[[C1_IDX_0]], %[[C2_IDX]], %[[C1_IDX_1]] : (index, index, index) -> !fir.slice<1>
+! CHECK: %[[BOX_R:.*]] = fir.embox %[[R]](%[[SHAPE]]) [%[[SLICE]]] : (!fir.ref<!fir.array<2x!fir.char<1,12>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<2x!fir.char<1,12>>>
+! CHECK: %[[BOX_R_NONE:.*]] = fir.convert %[[BOX_R]] : (!fir.box<!fir.array<2x!fir.char<1,12>>>) -> !fir.box<none>
+! CHECK: %[[DATA:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,14>>
+! CHECK: %[[DATA_PTR:.*]] = fir.convert %8 : (!fir.ref<!fir.char<1,14>>) -> !fir.ref<i8>
+! CHECK: %{{.*}} = fir.call @_FortranAioBeginInternalArrayFormattedOutput(%[[BOX_R_NONE]], %[[DATA_PTR]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.ref<i8>, i64, !fir.box<none>, !fir.ref<!fir.llvm_ptr<i8>>, i64, !fir.ref<i8>, i32) -> !fir.ref<i8>