diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp --- a/flang/lib/Optimizer/Builder/MutableBox.cpp +++ b/flang/lib/Optimizer/Builder/MutableBox.cpp @@ -64,6 +64,12 @@ cleanedAddr = builder.createConvert(loc, type, addr); if (charTy.getLen() == fir::CharacterType::unknownLen()) cleanedLengths.append(lengths.begin(), lengths.end()); + } else if (fir::isUnlimitedPolymorphicType(box.getBoxTy())) { + if (auto charTy = fir::dyn_cast_ptrEleTy(addr.getType()) + .dyn_cast()) { + if (charTy.getLen() == fir::CharacterType::unknownLen()) + cleanedLengths.append(lengths.begin(), lengths.end()); + } } else if (box.isDerivedWithLenParameters()) { TODO(loc, "updating mutablebox of derived type with length parameters"); cleanedLengths = lengths; diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90 --- a/flang/test/Lower/polymorphic.f90 +++ b/flang/test/Lower/polymorphic.f90 @@ -970,6 +970,23 @@ ! CHECK: %[[BOX_NONE2:.*]] = fir.convert %[[EMBOX_B]] : (!fir.box>>>}>>) -> !fir.box ! CHECK: %{{.*}} = fir.call @_FortranAAssign(%[[BOX_NONE1]], %[[BOX_NONE2]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, !fir.box, !fir.ref, i32) -> none + subroutine up_pointer(p) + class(*), pointer, intent(in) :: p + end subroutine + + subroutine test_char_to_up_pointer(c) + character(*), target :: c + call up_pointer(c) + end subroutine + +! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_char_to_up_pointer( +! CHECK-SAME: %[[C:.*]]: !fir.boxchar<1> {fir.bindc_name = "c", fir.target}) { +! CHECK: %[[NEW_BOX:.*]] = fir.alloca !fir.class> +! CHECK: %[[UNBOXCHAR:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[EMBOX:.*]] = fir.embox %[[UNBOXCHAR]]#0 typeparams %[[UNBOXCHAR]]#1 : (!fir.ref>, index) -> !fir.class> +! CHECK: fir.store %[[EMBOX]] to %[[NEW_BOX]] : !fir.ref>> +! CHECK: fir.call @_QMpolymorphic_testPup_pointer(%[[NEW_BOX]]) {{.*}} : (!fir.ref>>) -> () + end module program test