diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 4011ea4a3be6a..8d3ab0b3745bd 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -621,8 +621,13 @@ isOptimizableTranspose(const Fortran::evaluate::ProcedureRef &procRef, const Fortran::lower::AbstractConverter &converter) { const Fortran::evaluate::SpecificIntrinsic *intrin = procRef.proc().GetSpecificIntrinsic(); - return isTransposeOptEnabled(converter) && intrin && - intrin->name == "transpose"; + if (isTransposeOptEnabled(converter) && intrin && + intrin->name == "transpose") { + const std::optional matrix = + procRef.arguments().at(0); + return !(matrix && matrix->GetType() && matrix->GetType()->IsPolymorphic()); + } + return false; } template diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index cc01e49854a23..49e34e60d3a7d 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -4967,8 +4967,9 @@ IntrinsicLibrary::genTranspose(mlir::Type resultType, // Create mutable fir.box to be passed to the runtime for the result. mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 2); - fir::MutableBoxValue resultMutableBox = - fir::factory::createTempMutableBox(builder, loc, resultArrayType); + fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox( + builder, loc, resultArrayType, {}, + fir::isPolymorphicType(source.getType()) ? source : mlir::Value{}); mlir::Value resultIrBox = fir::factory::getMutableIRBox(builder, loc, resultMutableBox); // Call runtime. The runtime is allocating the result. diff --git a/flang/test/Lower/polymorphic-temp.f90 b/flang/test/Lower/polymorphic-temp.f90 index 4ee807af056cd..e3021df474382 100644 --- a/flang/test/Lower/polymorphic-temp.f90 +++ b/flang/test/Lower/polymorphic-temp.f90 @@ -102,14 +102,14 @@ subroutine test_temp_from_intrinsic_pack(i, mask) ! CHECK: %[[MASK_BOX_NONE:.*]] = fir.convert %[[EMBOXED_MASK]] : (!fir.box>>) -> !fir.box ! CHECK: %{{.*}} = fir.call @_FortranAPack(%[[RES_BOX_NONE]], %[[I_BOX_NONE]], %[[MASK_BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, !fir.box, !fir.box, !fir.box, !fir.ref, i32) -> none - subroutine check_unpack(r) + subroutine check_rank2(r) class(p1), intent(in) :: r(:,:) end subroutine subroutine test_temp_from_unpack(v, m, f) class(p1), intent(in) :: v(:), f(:,:) logical, intent(in) :: m(:,:) - call check_unpack(unpack(v,m,f)) + call check_rank2(unpack(v,m,f)) end subroutine ! CHECK-LABEL: func.func @_QMpoly_tmpPtest_temp_from_unpack( @@ -173,4 +173,16 @@ subroutine test_temp_from_intrinsic_transfer(source, mold) ! CHECK: %[[MOLD_NONE:.*]] = fir.convert %[[MOLD]] : (!fir.class>>) -> !fir.box ! CHECK: %{{.*}} = fir.call @_FortranATransfer(%[[RES_BOX_NONE]], %[[SOURCE_NONE]], %[[MOLD_NONE]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, !fir.box, !fir.box, !fir.ref, i32) -> none + subroutine test_temp_from_intrinsic_transpose(matrix) + class(p1), intent(in) :: matrix(:,:) + call check_rank2(transpose(matrix)) + end subroutine + +! CHECK-LABEL: func.func @_QMpoly_tmpPtest_temp_from_intrinsic_transpose( +! CHECK-SAME: %[[MATRIX:.*]]: !fir.class>> {fir.bindc_name = "matrix"}) { +! CHECK: %[[TMP_RES:.*]] = fir.alloca !fir.class>>> +! CHECK: %[[RES_BOX_NONE:.*]] = fir.convert %[[TMP_RES]] : (!fir.ref>>>>) -> !fir.ref> +! CHECK: %[[MATRIX_NONE:.*]] = fir.convert %[[MATRIX]] : (!fir.class>>) -> !fir.box +! CHECK: %{{.*}} = fir.call @_FortranATranspose(%[[RES_BOX_NONE]], %[[MATRIX_NONE]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, !fir.box, !fir.ref, i32) -> none + end module