diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp --- a/flang/lib/Lower/IO.cpp +++ b/flang/lib/Lower/IO.cpp @@ -1315,11 +1315,11 @@ /// (normally 1), then a descriptor is required by the runtime IO API. This /// condition holds even in F77 sources. static llvm::Optional 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 @@ template static llvm::Optional 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(&stmt.iounit->u)) - return getVariableBufferRequiredDescriptor(converter, *var, stmtCtx); + return getVariableBufferRequiredDescriptor(converter, loc, *var, stmtCtx); if (auto *unit = getIOControl(stmt)) if (auto *var = std::get_if(&unit->u)) - return getVariableBufferRequiredDescriptor(converter, *var, stmtCtx); + return getVariableBufferRequiredDescriptor(converter, loc, *var, stmtCtx); return llvm::None; } template <> inline llvm::Optional maybeGetInternalIODescriptor( - 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 @@ const bool isList = isFormatted ? isDataTransferList(stmt) : false; const bool isInternal = isDataTransferInternal(stmt); llvm::Optional 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 --- /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>> +! 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.shape<1>, !fir.slice<1>) -> !fir.box>> +! CHECK: %[[BOX_R_NONE:.*]] = fir.convert %[[BOX_R]] : (!fir.box>>) -> !fir.box +! CHECK: %[[DATA:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[DATA_PTR:.*]] = fir.convert %8 : (!fir.ref>) -> !fir.ref +! CHECK: %{{.*}} = fir.call @_FortranAioBeginInternalArrayFormattedOutput(%[[BOX_R_NONE]], %[[DATA_PTR]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.box, !fir.ref, i64, !fir.box, !fir.ref>, i64, !fir.ref, i32) -> !fir.ref