diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp index d4cdfecd0b088..bcec49b3e3c8e 100644 --- a/flang/lib/Optimizer/Builder/MutableBox.cpp +++ b/flang/lib/Optimizer/Builder/MutableBox.cpp @@ -67,7 +67,7 @@ createNewFirBox(fir::FirOpBuilder &builder, mlir::Location loc, cleanedLengths.append(lengths.begin(), lengths.end()); } else if (fir::isUnlimitedPolymorphicType(box.getBoxTy())) { if (auto charTy = mlir::dyn_cast( - fir::dyn_cast_ptrEleTy(addr.getType()))) { + fir::getFortranElementType(addr.getType()))) { if (charTy.getLen() == fir::CharacterType::unknownLen()) cleanedLengths.append(lengths.begin(), lengths.end()); } diff --git a/flang/test/Lower/HLFIR/actual_target_for_dummy_pointer.f90 b/flang/test/Lower/HLFIR/actual_target_for_dummy_pointer.f90 index cd0398c1850fb..efe9e6dd190c0 100644 --- a/flang/test/Lower/HLFIR/actual_target_for_dummy_pointer.f90 +++ b/flang/test/Lower/HLFIR/actual_target_for_dummy_pointer.f90 @@ -246,7 +246,7 @@ end subroutine char_explicit_shape_array ! CHECK: fir.store %[[VAL_30]] to %[[VAL_2]] : !fir.ref>>>> ! CHECK: fir.call @_QPchar_explicit_shape_array_assumed_len_callee(%[[VAL_2]]) fastmath : (!fir.ref>>>>) -> () ! CHECK: %[[VAL_31:.*]] = fir.shape %[[VAL_14]] : (index) -> !fir.shape<1> -! CHECK: %[[VAL_32:.*]] = fir.embox %[[VAL_16]]#1(%[[VAL_31]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.class>> +! CHECK: %[[VAL_32:.*]] = fir.embox %[[VAL_16]]#1(%[[VAL_31]]) typeparams %[[VAL_12]]#1 : (!fir.ref>>, !fir.shape<1>, index) -> !fir.class>> ! CHECK: fir.store %[[VAL_32]] to %[[VAL_1]] : !fir.ref>>> ! CHECK: fir.call @_QPchar_explicit_shape_array_uclass_callee(%[[VAL_1]]) fastmath : (!fir.ref>>>) -> () ! CHECK: return diff --git a/flang/test/Lower/call-character-array-to-polymorphic-pointer.f90 b/flang/test/Lower/call-character-array-to-polymorphic-pointer.f90 new file mode 100644 index 0000000000000..8644a4a3faf7f --- /dev/null +++ b/flang/test/Lower/call-character-array-to-polymorphic-pointer.f90 @@ -0,0 +1,29 @@ +! Test passing character array to unlimited polymorphic array pointer. +! Regression test from https://github.com/llvm/llvm-project/issues/150749 + +! RUN: bbc -emit-hlfir -o - %s | FileCheck %s + +subroutine char_explicit_shape_array(a2) +interface +subroutine char_explicit_shape_array_uclass_callee(p) + class(*), pointer, intent(in) :: p(:) +end subroutine char_explicit_shape_array_uclass_callee +end interface +character(*), target :: a2(100) +call char_explicit_shape_array_uclass_callee(a2) +end subroutine char_explicit_shape_array +! CHECK-LABEL: func.func @_QPchar_explicit_shape_array( +! CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<1> {fir.bindc_name = "a2", fir.target}) { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.class>> +! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]]#0 : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_4:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_5]]) typeparams %[[VAL_2]]#1 dummy_scope %[[VAL_1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFchar_explicit_shape_arrayEa2"} : (!fir.ref>>, !fir.shape<1>, index, !fir.dscope) -> (!fir.box>>, !fir.ref>>) +! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_8:.*]] = fir.embox %[[VAL_6]]#1(%[[VAL_7]]) typeparams %[[VAL_2]]#1 : (!fir.ref>>, !fir.shape<1>, index) -> !fir.class>> +! CHECK: fir.store %[[VAL_8]] to %[[VAL_0]] : !fir.ref>>> +! CHECK: fir.call @_QPchar_explicit_shape_array_uclass_callee(%[[VAL_0]]) fastmath : (!fir.ref>>>) -> () +! CHECK: return +! CHECK: }