diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h --- a/flang/include/flang/Optimizer/Dialect/FIRType.h +++ b/flang/include/flang/Optimizer/Dialect/FIRType.h @@ -286,6 +286,9 @@ /// Return true iff `ty` is !fir.box type. bool isOpaqueDescType(mlir::Type ty); +/// Return the nested RecordType if one if found. Return ty otherwise. +mlir::Type getDerivedType(mlir::Type ty); + /// Return true iff `ty` is the type of an polymorphic entity or /// value. bool isPolymorphicType(mlir::Type ty); 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 @@ -658,7 +658,8 @@ // same as its declared type. auto boxTy = box.getBoxTy().dyn_cast(); auto eleTy = fir::dyn_cast_ptrOrBoxEleTy(boxTy.getEleTy()); - if (auto recTy = eleTy.dyn_cast()) + mlir::Type derivedType = fir::getDerivedType(eleTy); + if (auto recTy = derivedType.dyn_cast()) fir::runtime::genNullifyDerivedType(builder, loc, box.getAddr(), recTy, box.rank()); return; 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 @@ -936,17 +936,8 @@ return emitError(loc) << "no binding tables found"; // Get derived type information. - auto declaredType = - llvm::TypeSwitch( - dispatch.getObject().getType().getEleTy()) - .Case( - [](auto p) { - if (auto seq = - p.getEleTy().template dyn_cast()) - return seq.getEleTy(); - return p.getEleTy(); - }) - .Default([](mlir::Type t) { return t; }); + mlir::Type declaredType = + fir::getDerivedType(dispatch.getObject().getType().getEleTy()); assert(declaredType.isa() && "expecting fir.type"); auto recordType = declaredType.dyn_cast(); diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp --- a/flang/lib/Optimizer/Dialect/FIRType.cpp +++ b/flang/lib/Optimizer/Dialect/FIRType.cpp @@ -198,6 +198,16 @@ return isa_fir_type(t) || isa_std_type(t); } +mlir::Type getDerivedType(mlir::Type ty) { + return llvm::TypeSwitch(ty) + .Case([](auto p) { + if (auto seq = p.getEleTy().template dyn_cast()) + return seq.getEleTy(); + return p.getEleTy(); + }) + .Default([](mlir::Type t) { return t; }); +} + mlir::Type dyn_cast_ptrEleTy(mlir::Type t) { return llvm::TypeSwitch(t) .Case>) -> !fir.ptr> ! CHECK: fir.store %[[CONVERT]] to %[[PTR]] : !fir.ref>> + subroutine nullify_pointer_array(a) + type(p3) :: a + nullify(a%p) + end subroutine + +! CHECK-LABEL: func.func @_QMpolymorphic_testPnullify_pointer_array( +! CHECK-SAME: %[[ARG0:.*]]: !fir.ref>>>}>> {fir.bindc_name = "a"}) { +! CHECK: %[[FIELD_P:.*]] = fir.field_index p, !fir.type<_QMpolymorphic_testTp3{p:!fir.class>>>}> +! CHECK: %[[COORD_P:.*]] = fir.coordinate_of %[[ARG0]], %[[FIELD_P]] : (!fir.ref>>>}>>, !fir.field) -> !fir.ref>>>}>>>>> +! CHECK: %[[TYPE_DESC_ADDR:.*]] = fir.address_of(@_QMpolymorphic_testE.dt.p3) : !fir.ref> +! CHECK: %[[CONV_P:.*]] = fir.convert %[[COORD_P]] : (!fir.ref>>>}>>>>>) -> !fir.ref> +! CHECK: %[[CONV_TDESC:.*]] = fir.convert %[[TYPE_DESC_ADDR]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[C1:.*]] = arith.constant 1 : i32 +! CHECK: %[[C0:.*]] = arith.constant 0 : i32 +! CHECK: %{{.*}} = fir.call @_FortranAPointerNullifyDerived(%[[CONV_P]], %[[CONV_TDESC]], %[[C1]], %[[C0]]) {{.*}} : (!fir.ref>, !fir.ref, i32, i32) -> none + end module