forked from OSchip/llvm-project
[flang] Create a temporary of the correct size when lowering SetLength
This patch creates a temporary of the appropriate length while lowering SetLength. The corresponding character can be truncated or padded if necessary. This fix issue with array constructor in argument and also with statement function. ``` character(7) :: str = "1234567" call s(str(1:1)) contains subroutine s(a) character(*) :: a call s2([Character(3)::a]) end subroutine subroutine s2(c) character(3) :: c(1) print "(4a)", c(1), "end" end subroutine end ``` The example prior the patch prints `123end` instead of `1. end` Reviewed By: PeteSteinfeld, jeanPerier Differential Revision: https://reviews.llvm.org/D132464
This commit is contained in:
parent
23a1c0a779
commit
9d162ecb3b
|
@ -1315,7 +1315,11 @@ public:
|
|||
ExtValue genval(const Fortran::evaluate::SetLength<KIND> &x) {
|
||||
mlir::Value newLenValue = genunbox(x.right());
|
||||
fir::ExtendedValue lhs = gen(x.left());
|
||||
return replaceScalarCharacterLength(lhs, newLenValue);
|
||||
fir::factory::CharacterExprHelper charHelper(builder, getLoc());
|
||||
fir::CharBoxValue temp = charHelper.createCharacterTemp(
|
||||
charHelper.getCharacterType(fir::getBase(lhs).getType()), newLenValue);
|
||||
charHelper.createAssign(temp, lhs);
|
||||
return fir::ExtendedValue{temp};
|
||||
}
|
||||
|
||||
template <int KIND>
|
||||
|
|
|
@ -101,6 +101,7 @@ integer function test_stmt_character(c, j)
|
|||
test_stmt_character = func(c, j)
|
||||
end function
|
||||
|
||||
|
||||
! Test statement function with a character actual argument whose
|
||||
! length may be different than the dummy length (the dummy length
|
||||
! must be used inside the statement function).
|
||||
|
@ -145,3 +146,34 @@ subroutine bug247(r)
|
|||
PRINT *, I(2.5)
|
||||
! CHECK: fir.call {{.*}}EndIo
|
||||
END subroutine bug247
|
||||
|
||||
! Test that the argument is truncated to the length of the dummy argument.
|
||||
subroutine truncate_arg
|
||||
character(4) arg
|
||||
character(10) stmt_fct
|
||||
stmt_fct(arg) = arg
|
||||
print *, stmt_fct('longer_arg')
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: @_QPtruncate_arg
|
||||
! CHECK: %[[c4:.*]] = arith.constant 4 : i32
|
||||
! CHECK: %[[arg:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,10>>
|
||||
! CHECK: %[[cast_arg:.*]] = fir.convert %[[arg]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>>
|
||||
! CHECK: %[[c10:.*]] = arith.constant 10 : i64
|
||||
! CHECK: %[[temp:.*]] = fir.alloca !fir.char<1,10> {bindc_name = ".chrtmp"}
|
||||
! CHECK: %[[c10_index:.*]] = fir.convert %[[c10]] : (i64) -> index
|
||||
! CHECK: %[[c4_index:.*]] = fir.convert %[[c4]] : (i32) -> index
|
||||
! CHECK: %[[cmpi:.*]] = arith.cmpi slt, %[[c10_index]], %[[c4_index]] : index
|
||||
! CHECK: %[[select:.*]] = arith.select %[[cmpi]], %[[c10_index]], %[[c4_index]] : index
|
||||
! CHECK: %[[c1:.*]] = arith.constant 1 : i64
|
||||
! CHECK: %[[select_i64:.*]] = fir.convert %[[select]] : (index) -> i64
|
||||
! CHECK: %[[length:.*]] = arith.muli %[[c1]], %[[select_i64]] : i64
|
||||
! CHECK: %[[cast_temp_i8:.*]] = fir.convert %[[temp]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8>
|
||||
! CHECK: %[[cast_arg_i8:.*]] = fir.convert %[[cast_arg]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
|
||||
! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[cast_temp_i8]], %[[cast_arg_i8]], %[[length]], %{{.*}}) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
|
||||
! CHECK: %[[c1_i64:.*]] = arith.constant 1 : i64
|
||||
! CHECK: %[[ub:.*]] = arith.subi %[[c10]], %[[c1_i64]] : i64
|
||||
! CHECK: %[[ub_index:.*]] = fir.convert %[[ub]] : (i64) -> index
|
||||
! CHECK: fir.do_loop %{{.*}} = %[[select]] to %[[ub_index]] step %{{.*}} {
|
||||
! CHECK: %[[cast_temp:.*]] = fir.convert %[[temp:.*]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8>
|
||||
! CHECK: %{{.*}} = fir.call @_FortranAioOutputAscii(%{{.*}}, %[[cast_temp]], %[[c10]]) : (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1
|
||||
|
|
Loading…
Reference in New Issue