diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp --- a/flang/lib/Lower/Allocatable.cpp +++ b/flang/lib/Lower/Allocatable.cpp @@ -141,7 +141,7 @@ static void genRuntimeInitCharacter(fir::FirOpBuilder &builder, mlir::Location loc, const fir::MutableBoxValue &box, - mlir::Value len) { + mlir::Value len, int64_t kind = 0) { mlir::func::FuncOp callee = box.isPointer() ? fir::runtime::getRuntimeFunc( @@ -155,7 +155,8 @@ llvm::SmallVector args; args.push_back(builder.createConvert(loc, inputTypes[0], box.getAddr())); args.push_back(builder.createConvert(loc, inputTypes[1], len)); - int kind = box.getEleTy().cast().getFKind(); + if (kind == 0) + kind = box.getEleTy().cast().getFKind(); args.push_back(builder.createIntegerConstant(loc, inputTypes[2], kind)); int rank = box.rank(); args.push_back(builder.createIntegerConstant(loc, inputTypes[3], rank)); @@ -663,10 +664,17 @@ // unlimited polymorphic entity. if (typeSpec->AsIntrinsic() && fir::isUnlimitedPolymorphicType(fir::getBase(box).getType())) { - genInitIntrinsic( - box, typeSpec->AsIntrinsic()->category(), - Fortran::evaluate::ToInt64(typeSpec->AsIntrinsic()->kind()).value(), - alloc.getSymbol().Rank()); + if (typeSpec->AsIntrinsic()->category() == TypeCategory::Character) { + genRuntimeInitCharacter( + builder, loc, box, lenParams[0], + Fortran::evaluate::ToInt64(typeSpec->AsIntrinsic()->kind()) + .value()); + } else { + genInitIntrinsic( + box, typeSpec->AsIntrinsic()->category(), + Fortran::evaluate::ToInt64(typeSpec->AsIntrinsic()->kind()).value(), + alloc.getSymbol().Rank()); + } return; } diff --git a/flang/test/Lower/allocatable-polymorphic.f90 b/flang/test/Lower/allocatable-polymorphic.f90 --- a/flang/test/Lower/allocatable-polymorphic.f90 +++ b/flang/test/Lower/allocatable-polymorphic.f90 @@ -536,6 +536,22 @@ ! CHECK: %[[BOX_NONE_10:.*]] = fir.convert %[[EMBOX_10]] : (!fir.box) -> !fir.box ! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocateSource(%[[A_BOX_NONE]], %[[BOX_NONE_10]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 + subroutine test_allocatable_up_character() + class(*), allocatable :: a + allocate(character*10::a) + end subroutine + +! CHECK-LABEL: func.func @_QMpolyPtest_allocatable_up_character() { +! CHECK: %[[A:.*]] = fir.alloca !fir.class> {bindc_name = "a", uniq_name = "_QMpolyFtest_allocatable_up_characterEa"} +! CHECK: %[[LEN:.*]] = arith.constant 10 : i64 +! CHECK: %[[A_NONE:.*]] = fir.convert %[[A]] : (!fir.ref>>) -> !fir.ref> +! CHECK: %[[KIND:.*]] = arith.constant 1 : i32 +! CHECK: %[[RANK:.*]] = arith.constant 0 : i32 +! CHECK: %[[CORANK:.*]] = arith.constant 0 : i32 +! CHECK: %{{.*}} = fir.call @_FortranAAllocatableInitCharacter(%[[A_NONE]], %[[LEN]], %[[KIND]], %[[RANK]], %[[CORANK]]) {{.*}} : (!fir.ref>, i64, i32, i32, i32) -> none +! CHECK: %[[A_NONE:.*]] = fir.convert %[[A:.*]] : (!fir.ref>>) -> !fir.ref> +! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate(%[[A_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 + end module