diff --git a/flang/lib/Lower/HlfirIntrinsics.cpp b/flang/lib/Lower/HlfirIntrinsics.cpp --- a/flang/lib/Lower/HlfirIntrinsics.cpp +++ b/flang/lib/Lower/HlfirIntrinsics.cpp @@ -278,8 +278,9 @@ mlir::Type elementType = array.getEleTy(); resultShape.push_back(arrayShape[0]); resultShape.push_back(arrayShape[1]); - mlir::Type resultTy = hlfir::ExprType::get( - builder.getContext(), resultShape, elementType, /*polymorphic=*/false); + mlir::Type resultTy = + hlfir::ExprType::get(builder.getContext(), resultShape, elementType, + fir::isPolymorphicType(stmtResultType)); return createOp(resultTy, operands[0]); } diff --git a/flang/test/Lower/HLFIR/transpose.f90 b/flang/test/Lower/HLFIR/transpose.f90 --- a/flang/test/Lower/HLFIR/transpose.f90 +++ b/flang/test/Lower/HLFIR/transpose.f90 @@ -1,5 +1,5 @@ ! Test lowering of TRANSPOSE intrinsic to HLFIR -! RUN: bbc -emit-hlfir -o - %s 2>&1 | FileCheck %s +! RUN: bbc -emit-hlfir --polymorphic-type -o - %s 2>&1 | FileCheck %s subroutine transpose1(m, res) integer :: m(1,2), res(2, 1) @@ -45,3 +45,20 @@ ! CHECK-NEXT: hlfir.destroy %[[EXPR]] ! CHECK-NEXT: return ! CHECK-NEXT: } + +! Test that the result type is polymorphic. +subroutine test_polymorphic_result(m, res) + class(*), allocatable, dimension(:, :) :: m, res + res = transpose(m) +end subroutine test_polymorphic_result +! CHECK-LABEL: func.func @_QPtest_polymorphic_result( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>> {fir.bindc_name = "m"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref>>> {fir.bindc_name = "res"}) { +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_polymorphic_resultEm"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_polymorphic_resultEres"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref>>> +! CHECK: %[[VAL_5:.*]] = hlfir.transpose %[[VAL_4]] : (!fir.class>>) -> !hlfir.expr +! CHECK: hlfir.assign %[[VAL_5]] to %[[VAL_3]]#0 realloc : !hlfir.expr, !fir.ref>>> +! CHECK: hlfir.destroy %[[VAL_5]] : !hlfir.expr +! CHECK: return +! CHECK: }