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 @@ -496,8 +496,11 @@ loc, fir::ReferenceType::get(typeDescGlobal.getType()), typeDescGlobal.getSymbol()); mlir::func::FuncOp callee = - fir::runtime::getRuntimeFunc(loc, - builder); + box.isPointer() + ? fir::runtime::getRuntimeFunc( + loc, builder) + : fir::runtime::getRuntimeFunc( + loc, builder); llvm::ArrayRef inputTypes = callee.getFunctionType().getInputs(); @@ -667,7 +670,7 @@ fir::MutableProperties mutableProperties; std::string name = converter.mangleName(sym); mlir::Type baseAddrTy = converter.genType(sym); - if (auto boxType = baseAddrTy.dyn_cast()) + if (auto boxType = baseAddrTy.dyn_cast()) baseAddrTy = boxType.getEleTy(); // Allocate and set a variable to hold the address. // It will be set to null in setUnallocatedStatus. diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -480,7 +480,7 @@ mlir::Value a = adaptor.getOperands()[0]; auto loc = boxaddr.getLoc(); mlir::Type ty = convertType(boxaddr.getType()); - if (auto argty = boxaddr.getVal().getType().dyn_cast()) { + if (auto argty = boxaddr.getVal().getType().dyn_cast()) { rewriter.replaceOp(boxaddr, loadBaseAddrFromBox(loc, ty, a, rewriter)); } else { rewriter.replaceOpWithNewOp(boxaddr, a, 0); 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 @@ -35,6 +35,93 @@ class(p2) :: this print*, 'call proc2_p2' end subroutine + + subroutine test_pointer() + class(p1), pointer :: p + class(p1), pointer :: c1, c2 + class(p1), pointer, dimension(:) :: c3, c4 + + print*, 'test allocation of polymorphic pointers' + + allocate(p) + + allocate(p1::c1) + allocate(p2::c2) + + allocate(p1::c3(10)) + allocate(p2::c4(20)) + + end subroutine + +! CHECK-LABEL: func.func @_QMpolyPtest_pointer() +! CHECK: %[[C1_DESC:.*]] = fir.alloca !fir.class>> {bindc_name = "c1", uniq_name = "_QMpolyFtest_pointerEc1"} +! CHECK: %[[C1_ADDR:.*]] = fir.alloca !fir.ptr> {uniq_name = "_QMpolyFtest_pointerEc1.addr"} +! CHECK: %[[C2_DESC:.*]] = fir.alloca !fir.class>> {bindc_name = "c2", uniq_name = "_QMpolyFtest_pointerEc2"} +! CHECK: %[[C2_ADDR:.*]] = fir.alloca !fir.ptr> {uniq_name = "_QMpolyFtest_pointerEc2.addr"} +! CHECK: %[[C3_DESC:.*]] = fir.alloca !fir.class>>> {bindc_name = "c3", uniq_name = "_QMpolyFtest_pointerEc3"} +! CHECK: %[[C4_DESC:.*]] = fir.alloca !fir.class>>> {bindc_name = "c4", uniq_name = "_QMpolyFtest_pointerEc4"} +! CHECK: %[[P_DESC:.*]] = fir.alloca !fir.class>> {bindc_name = "p", uniq_name = "_QMpolyFtest_pointerEp"} +! CHECK: %[[P_ADDR:.*]] = fir.alloca !fir.ptr> {uniq_name = "_QMpolyFtest_pointerEp.addr"} + +! CHECK: %[[TYPE_DESC_P1:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref> +! CHECK: %[[P_DESC_CAST:.*]] = fir.convert %[[P_DESC]] : (!fir.ref>>>) -> !fir.ref> +! CHECK: %[[TYPE_DESC_P1_CAST:.*]] = fir.convert %[[TYPE_DESC_P1]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[RANK:.*]] = arith.constant 0 : i32 +! CHECK: %[[CORANK:.*]] = arith.constant 0 : i32 +! CHECK: %{{.*}} = fir.call @_FortranAPointerNullifyDerived(%[[P_DESC_CAST]], %[[TYPE_DESC_P1_CAST]], %[[RANK]], %[[CORANK]]) : (!fir.ref>, !fir.ref, i32, i32) -> none +! CHECK: %[[P_DESC_CAST:.*]] = fir.convert %[[P_DESC]] : (!fir.ref>>>) -> !fir.ref> +! CHECK: %{{.*}} = fir.call @_FortranAPointerAllocate(%[[P_DESC_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK: %[[P_LOAD:.*]] = fir.load %[[P_DESC]] : !fir.ref>>> +! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[P_LOAD]] : (!fir.class>>) -> !fir.ptr> +! CHECK: fir.store %[[BOX_ADDR]] to %[[P_ADDR]] : !fir.ref>> + +! CHECK: %[[TYPE_DESC_P1:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref> +! CHECK: %[[C1_DESC_CAST:.*]] = fir.convert %[[C1_DESC:.*]] : (!fir.ref>>>) -> !fir.ref> +! CHECK: %[[TYPE_DESC_P1_CAST:.*]] = fir.convert %[[TYPE_DESC_P1]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[RANK:.*]] = arith.constant 0 : i32 +! CHECK: %[[CORANK:.*]] = arith.constant 0 : i32 +! CHECK: %{{.*}} = fir.call @_FortranAPointerNullifyDerived(%[[C1_DESC_CAST]], %[[TYPE_DESC_P1_CAST]], %[[RANK]], %[[CORANK]]) : (!fir.ref>, !fir.ref, i32, i32) -> none +! CHECK: %[[C1_DESC_CAST:.*]] = fir.convert %[[C1_DESC]] : (!fir.ref>>>) -> !fir.ref> +! CHECK: %{{.*}} = fir.call @_FortranAPointerAllocate(%[[C1_DESC_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK: %[[C1_LOAD:.*]] = fir.load %[[C1_DESC]] : !fir.ref>>> +! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[C1_LOAD]] : (!fir.class>>) -> !fir.ptr> +! CHECK: fir.store %[[BOX_ADDR]] to %[[C1_ADDR]] : !fir.ref>> + +! CHECK: %[[TYPE_DESC_P2:.*]] = fir.address_of(@_QMpolyE.dt.p2) : !fir.ref> +! CHECK: %[[C2_DESC_CAST:.*]] = fir.convert %[[C2_DESC]] : (!fir.ref>>>) -> !fir.ref> +! CHECK: %[[TYPE_DESC_P2_CAST:.*]] = fir.convert %[[TYPE_DESC_P2]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[RANK:.*]] = arith.constant 0 : i32 +! CHECK: %[[CORANK:.*]] = arith.constant 0 : i32 +! CHECK: %{{.*}} = fir.call @_FortranAPointerNullifyDerived(%[[C2_DESC_CAST]], %[[TYPE_DESC_P2_CAST]], %[[RANK]], %[[CORANK]]) : (!fir.ref>, !fir.ref, i32, i32) -> none +! CHECK: %[[C2_DESC_CAST:.*]] = fir.convert %[[C2_DESC]] : (!fir.ref>>>) -> !fir.ref> +! CHECK: %{{.*}} = fir.call @_FortranAPointerAllocate(%[[C2_DESC_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK: %[[C2_LOAD:.*]] = fir.load %[[C2_DESC]] : !fir.ref>>> +! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[C2_LOAD]] : (!fir.class>>) -> !fir.ptr> +! CHECK: fir.store %[[BOX_ADDR]] to %[[C2_ADDR]] : !fir.ref>> + +! CHECK: %[[TYPE_DESC_P1:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref> +! CHECK: %[[C3_CAST:.*]] = fir.convert %[[C3_DESC]] : (!fir.ref>>>>) -> !fir.ref> +! CHECK: %[[TYPE_DESC_P1_CAST:.*]] = fir.convert %[[TYPE_DESC_P1]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[RANK:.*]] = arith.constant 1 : i32 +! CHECK: %[[CORANK:.*]] = arith.constant 0 : i32 +! CHECK: %{{.*}} = fir.call @_FortranAPointerNullifyDerived(%[[C3_CAST]], %[[TYPE_DESC_P1_CAST]], %[[RANK]], %[[CORANK]]) : (!fir.ref>, !fir.ref, i32, i32) -> none +! CHECK: %[[C3_CAST:.*]] = fir.convert %[[C3_DESC]] : (!fir.ref>>>>) -> !fir.ref> +! CHECK: %{{.*}} = fir.call @_FortranAPointerSetBounds(%[[C3_CAST]], %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref>, i32, i64, i64) -> none +! CHECK: %[[C3_CAST:.*]] = fir.convert %[[C3_DESC]] : (!fir.ref>>>>) -> !fir.ref> +! CHECK: %{{.*}} = fir.call @_FortranAPointerAllocate(%[[C3_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 + +! CHECK: %[[TYPE_DESC_P2:.*]] = fir.address_of(@_QMpolyE.dt.p2) : !fir.ref> +! CHECK: %[[C4_CAST:.*]] = fir.convert %[[C4_DESC]] : (!fir.ref>>>>) -> !fir.ref> +! CHECK: %[[TYPE_DESC_P2_CAST:.*]] = fir.convert %[[TYPE_DESC_P2]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[RANK:.*]] = arith.constant 1 : i32 +! CHECK: %[[CORANK:.*]] = arith.constant 0 : i32 +! CHECK: %{{.*}} = fir.call @_FortranAPointerNullifyDerived(%[[C4_CAST]], %[[TYPE_DESC_P2_CAST]], %[[RANK]], %[[CORANK]]) : (!fir.ref>, !fir.ref, i32, i32) -> none +! CHECK: %[[C4_CAST:.*]] = fir.convert %[[C4_DESC]] : (!fir.ref>>>>) -> !fir.ref> +! CHECK: %{{.*}} = fir.call @_FortranAPointerSetBounds(%[[C4_CAST]], %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref>, i32, i64, i64) -> none +! CHECK: %[[C4_CAST:.*]] = fir.convert %[[C4_DESC]] : (!fir.ref>>>>) -> !fir.ref> +! CHECK: %{{.*}} = fir.call @_FortranAPointerAllocate(%[[C4_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 + + end module program test_allocatable @@ -66,6 +153,8 @@ do i = 1, 20 call c4(i)%proc2() end do + + call test_pointer() end ! CHECK-LABEL: func.func @_QQmain()