[flang] Support lowering of parent component in strecture constructor

[peixin]

Summary

Reuse the previous record assignment code. Use gen(expr) to generate
the fir::ExtendedValue of parent component recursively and convert the
structure to a fir.ref<T> type, where T is the record type of parent
component. Then, fir:🏭:genRecordAssignment can be reused to
assign the parent component to the type-casted structure.

[jeanPerier]

flang/lib/Lower/ConvertExpr.cpp

1069

I think you can simply convert res to a fir.ref<T> where T is the recordType of from, and call fir::factory::genRecordAssignment(builder, loc, resCast, from);. This should deal with the case where the runtime needs to be called without making a full copy of from before calling th

flang/lib/Optimizer/Builder/FIRBuilder.cpp

1053

I do not follow why this change was required. Doesn't llvm::zip already safely take the smallest of the two lists as iteration size ? I think the new code could segafult at compile time if genComponentByComponentAssignment was called with a lhs that has less components than the rhs (which would of course be a compiler bug)

1180

I think you can avoid adding genParentCompAssigment and all this by calling genRecordAssignment (the mutable box trick is a bit weird, better to keep it in one place).

[peixin]

Thanks @jeanPerier a lot for the suggestions.

I do not follow why this change was required. Doesn't llvm::zip already safely take the smallest of the two lists as iteration size ? I think the new code could segafult at compile time if genComponentByComponentAssignment was called with a lhs that has less components than the rhs (which would of course be a compiler bug)

Right. I had thought llvm::zip requires the size of two list to be the same. I was wrong.

flang/lib/Lower/ConvertExpr.cpp

1069

Good idea. This makes things much simple. Thanks for this.

[jeanPerier]

LGTM

flang/include/flang/Optimizer/Builder/FIRBuilder.h

void genScalarAssignment(fir::FirOpBuilder &builder, mlir::Location loc,
                          const fir::ExtendedValue &rhs);
 /// Assign \p rhs to \p lhs. Both \p rhs and \p lhs must be scalar derived
 /// types. The assignment follows Fortran intrinsic assignment semantic for
 /// derived types (10.2.1.3 point 13).
 void genRecordAssignment(fir::FirOpBuilder &builder, mlir::Location loc,
                          const fir::ExtendedValue &lhs,
                          const fir::ExtendedValue &rhs);
 
+/// Assign \p parent to \p rec. Both of them must be scalar derived types.
+void genParentCompAssigment(fir::FirOpBuilder &builder, mlir::Location loc,
+                            const fir::ExtendedValue &rec,
+                            const fir::ExtendedValue &parent);
+
 /// Builds and returns the type of a ragged array header used to cache mask
 /// evaluations. RaggedArrayHeader is defined in
 /// flang/include/flang/Runtime/ragged.h.
 mlir::TupleType getRaggedArrayHeaderType(fir::FirOpBuilder &builder);
 
 /// Generate the, possibly dynamic, LEN of a CHARACTER. \p arrLoad determines
 /// the base array. After applying \p path, the result must be a reference to a
 /// `!fir.char` type object. \p substring must have 0, 1, or 2 members. The

flang/lib/Lower/ConvertExpr.cpp

ExtValue genval(const Fortran::evaluate::StructureConstructor &ctor) {
     auto fieldTy = fir::FieldType::get(ty.getContext());
     mlir::Value res = builder.createTemporary(loc, recTy);
     mlir::Value box = builder.createBox(loc, fir::ExtendedValue{res});
     fir::runtime::genDerivedTypeInitialize(builder, loc, box);
 
     for (const auto &value : ctor.values()) {
       const Fortran::semantics::Symbol &sym = *value.first;
       const Fortran::lower::SomeExpr &expr = value.second.value();
-      // Parent components need more work because they do not appear in the
-      // fir.rec type.
-      if (sym.test(Fortran::semantics::Symbol::Flag::ParentComp))
-        TODO(loc, "parent component in structure constructor");
+
+      if (sym.test(Fortran::semantics::Symbol::Flag::ParentComp)) {
+        ExtValue from = gen(expr);
+        fir::factory::genParentCompAssigment(builder, loc, res, from);
+        continue;
+      }
 
       if (isDerivedTypeWithLenParameters(sym))
         TODO(loc, "component with length parameters in structure constructor");
 
       llvm::StringRef name = toStringRef(sym.name());
       // FIXME: type parameters must come from the derived-type-spec
       mlir::Value field = builder.create<fir::FieldIndexOp>(
           loc, fieldTy, name, ty,
           /*typeParams=*/mlir::ValueRange{} /*TODO*/);
       mlir::Type coorTy = builder.getRefType(recTy.getType(name));
-      auto coor = builder.create<fir::CoordinateOp>(loc, coorTy,
-                                                    fir::getBase(res), field);
+      auto coor = builder.create<fir::CoordinateOp>(loc, coorTy, res, field);
       ExtValue to = fir::factory::componentToExtendedValue(builder, loc, coor);
       to.match(
           [&](const fir::UnboxedValue &toPtr) {
             ExtValue value = genval(expr);
             fir::factory::genScalarAssignment(builder, loc, to, value);
           },
           [&](const fir::CharBoxValue &) {
             ExtValue value = genval(expr);

flang/lib/Optimizer/Builder/FIRBuilder.cpp

static void genComponentByComponentAssignment(fir::FirOpBuilder &builder,
                                               const fir::ExtendedValue &rhs) {
   auto lbaseType = fir::unwrapPassByRefType(fir::getBase(lhs).getType());
   auto lhsType = lbaseType.dyn_cast<fir::RecordType>();
   assert(lhsType && "lhs must be a scalar record type");
   auto rbaseType = fir::unwrapPassByRefType(fir::getBase(rhs).getType());
   auto rhsType = rbaseType.dyn_cast<fir::RecordType>();
   assert(rhsType && "rhs must be a scalar record type");
   auto fieldIndexType = fir::FieldType::get(lhsType.getContext());
-  for (auto [lhsPair, rhsPair] :
-       llvm::zip(lhsType.getTypeList(), rhsType.getTypeList())) {
-    auto &[lFieldName, lFieldTy] = lhsPair;
-    auto &[rFieldName, rFieldTy] = rhsPair;
+  for (std::size_t i = 0; i < rhsType.getTypeList().size(); ++i) {
+    auto rFieldName = rhsType.getTypeList()[i].first;
+    auto rFieldTy = rhsType.getTypeList()[i].second;
+    auto lFieldName = lhsType.getTypeList()[i].first;
+    auto lFieldTy = lhsType.getTypeList()[i].second;
     assert(!fir::hasDynamicSize(lFieldTy) && !fir::hasDynamicSize(rFieldTy));
     mlir::Value rField = builder.create<fir::FieldIndexOp>(
         loc, fieldIndexType, rFieldName, rhsType, fir::getTypeParams(rhs));
     auto rFieldRefType = builder.getRefType(rFieldTy);
     mlir::Value fromCoor = builder.create<fir::CoordinateOp>(
         loc, rFieldRefType, fir::getBase(rhs), rField);
     mlir::Value field = builder.create<fir::FieldIndexOp>(
         loc, fieldIndexType, lFieldName, lhsType, fir::getTypeParams(lhs));
void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder,
   // component by component assignment. Note that a single fir.load/fir.store
   // could be used on "small" record types, but as the type size grows, this
   // leads to issues in LLVM (long compile times, long IR files, and even
   // asserts at some point). Since there is no good size boundary, just always
   // use component by component assignment here.
   genComponentByComponentAssignment(builder, loc, lhs, rhs);
 }
 
+void fir::factory::genParentCompAssigment(fir::FirOpBuilder &builder,
+                                          mlir::Location loc,
+                                          const fir::ExtendedValue &rec,
+                                          const fir::ExtendedValue &parent) {
+  fir::ExtendedValue parentVal = parent;
+  if (fir::getTypeParams(parent).size() > 0)
+    TODO(loc, "parent component with type parameters in structure constructor");
+  // Assign to one temporary storage if the component data source is mutable.
+  if (fir::getBase(parent).getType().isa<fir::BoxType>()) {
+    mlir::Type baseTy =
+        fir::unwrapPassByRefType(fir::getBase(parent).getType());
+    parentVal = builder.createTemporary(loc, baseTy);
+    auto to = fir::getBase(builder.createBox(loc, parentVal));
+    auto toMutableBox = builder.createTemporary(loc, to.getType());
+    builder.create<fir::StoreOp>(loc, to, toMutableBox);
+    auto parentBox = fir::getBase(builder.createBox(loc, parent));
+    fir::runtime::genAssign(builder, loc, toMutableBox, parentBox);
+  }
+  // Assign the parent component one-by-one to target record.
+  genComponentByComponentAssignment(builder, loc, rec, parentVal);
+}
+
 mlir::TupleType
 fir::factory::getRaggedArrayHeaderType(fir::FirOpBuilder &builder) {
   mlir::IntegerType i64Ty = builder.getIntegerType(64);
   auto arrTy = fir::SequenceType::get(builder.getIntegerType(8), 1);
   auto buffTy = fir::HeapType::get(arrTy);
   auto extTy = fir::SequenceType::get(i64Ty, 1);
   auto shTy = fir::HeapType::get(extTy);
   return mlir::TupleType::get(builder.getContext(), {i64Ty, buffTy, shTy});

flang/test/Lower/structure-constructors.f90

end module
   integer, target :: i(4,3) = reshape([1,2,3,4,5,6,7,8,9,10,11,12], [4,3])
   call test_simple(42.)
   call test_char_scalar(42.)
   call test_simple_array(42., [1,2,3,4,5])
   call test_char_array(42., ["abc", "def", "geh", "ijk", "lmn"])
   call test_ptr(42., i)
   call test_nested(42., t_array(x=43., i=[5,6,7,8,9]))
 end
+
+! CHECK-LABEL: func.func @_QPtest_parent_component1() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.type<_QFtest_parent_component1Tmid{x:i32,y:!fir.array<2xi32>,mask:!fir.logical<4>}>
+! CHECK:         %[[VAL_14:.*]] = fir.field_index x, !fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>
+! CHECK:         %[[VAL_15:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_14]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>>, !fir.field) -> !fir.ref<i32>
+! CHECK:         %[[VAL_16:.*]] = arith.constant 1 : i32
+! CHECK:         fir.store %[[VAL_16]] to %[[VAL_15]] : !fir.ref<i32>
+! CHECK:         %[[VAL_17:.*]] = fir.field_index y, !fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>
+! CHECK:         %[[VAL_18:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_17]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>>, !fir.field) -> !fir.ref<!fir.array<2xi32>>
+! CHECK:         %[[VAL_19:.*]] = arith.constant 2 : index
+! CHECK:         %[[VAL_20:.*]] = fir.shape %[[VAL_19]] : (index) -> !fir.shape<1>
+! CHECK:         %[[VAL_21:.*]] = fir.array_load %[[VAL_18]](%[[VAL_20]]) : (!fir.ref<!fir.array<2xi32>>, !fir.shape<1>) -> !fir.array<2xi32>
+! CHECK:         %[[VAL_22:.*]] = fir.address_of(@_QQro.2xi4.a785b5f6447097efe271cc07e822fff0) : !fir.ref<!fir.array<2xi32>>
+! CHECK:         %[[VAL_23:.*]] = arith.constant 2 : index
+! CHECK:         %[[VAL_24:.*]] = fir.shape %[[VAL_23]] : (index) -> !fir.shape<1>
+! CHECK:         %[[VAL_25:.*]] = fir.array_load %[[VAL_22]](%[[VAL_24]]) : (!fir.ref<!fir.array<2xi32>>, !fir.shape<1>) -> !fir.array<2xi32>
+! CHECK:         %[[VAL_26:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_27:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_28:.*]] = arith.subi %[[VAL_19]], %[[VAL_26]] : index
+! CHECK:         %[[VAL_29:.*]] = fir.do_loop %[[VAL_30:.*]] = %[[VAL_27]] to %[[VAL_28]] step %[[VAL_26]] unordered iter_args(%[[VAL_31:.*]] = %[[VAL_21]]) -> (!fir.array<2xi32>) {
+! CHECK:           %[[VAL_32:.*]] = fir.array_fetch %[[VAL_25]], %[[VAL_30]] : (!fir.array<2xi32>, index) -> i32
+! CHECK:           %[[VAL_33:.*]] = fir.array_update %[[VAL_31]], %[[VAL_32]], %[[VAL_30]] : (!fir.array<2xi32>, i32, index) -> !fir.array<2xi32>
+! CHECK:           fir.result %[[VAL_33]] : !fir.array<2xi32>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_21]], %[[VAL_34:.*]] to %[[VAL_18]] : !fir.array<2xi32>, !fir.array<2xi32>, !fir.ref<!fir.array<2xi32>>
+! CHECK:         %[[VAL_35:.*]] = fir.field_index x, !fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>
+! CHECK:         %[[VAL_36:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_35]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>>, !fir.field) -> !fir.ref<i32>
+! CHECK:         %[[VAL_37:.*]] = fir.field_index x, !fir.type<_QFtest_parent_component1Tmid{x:i32,y:!fir.array<2xi32>,mask:!fir.logical<4>}>
+! CHECK:         %[[VAL_38:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_37]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tmid{x:i32,y:!fir.array<2xi32>,mask:!fir.logical<4>}>>, !fir.field) -> !fir.ref<i32>
+! CHECK:         %[[VAL_39:.*]] = fir.load %[[VAL_36]] : !fir.ref<i32>
+! CHECK:         fir.store %[[VAL_39]] to %[[VAL_38]] : !fir.ref<i32>
+! CHECK:         %[[VAL_40:.*]] = fir.field_index y, !fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>
+! CHECK:         %[[VAL_41:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_40]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>>, !fir.field) -> !fir.ref<!fir.array<2xi32>>
+! CHECK:         %[[VAL_42:.*]] = fir.field_index y, !fir.type<_QFtest_parent_component1Tmid{x:i32,y:!fir.array<2xi32>,mask:!fir.logical<4>}>
+! CHECK:         %[[VAL_43:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_42]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tmid{x:i32,y:!fir.array<2xi32>,mask:!fir.logical<4>}>>, !fir.field) -> !fir.ref<!fir.array<2xi32>>
+! CHECK:         %[[VAL_44:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_45:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_46:.*]] = arith.constant 1 : index
+! CHECK:         fir.do_loop %[[VAL_47:.*]] = %[[VAL_44]] to %[[VAL_46]] step %[[VAL_45]] {
+! CHECK:           %[[VAL_48:.*]] = fir.coordinate_of %[[VAL_43]], %[[VAL_47]] : (!fir.ref<!fir.array<2xi32>>, index) -> !fir.ref<i32>
+! CHECK:           %[[VAL_49:.*]] = fir.coordinate_of %[[VAL_41]], %[[VAL_47]] : (!fir.ref<!fir.array<2xi32>>, index) -> !fir.ref<i32>
+! CHECK:           %[[VAL_50:.*]] = fir.load %[[VAL_49]] : !fir.ref<i32>
+! CHECK:           fir.store %[[VAL_50]] to %[[VAL_48]] : !fir.ref<i32>
+! CHECK:         }
+! CHECK:         %[[VAL_51:.*]] = fir.field_index mask, !fir.type<_QFtest_parent_component1Tmid{x:i32,y:!fir.array<2xi32>,mask:!fir.logical<4>}>
+! CHECK:         %[[VAL_52:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_51]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tmid{x:i32,y:!fir.array<2xi32>,mask:!fir.logical<4>}>>, !fir.field) -> !fir.ref<!fir.logical<4>>
+! CHECK:         %[[VAL_53:.*]] = arith.constant true
+! CHECK:         %[[VAL_54:.*]] = fir.convert %[[VAL_53]] : (i1) -> !fir.logical<4>
+! CHECK:         fir.store %[[VAL_54]] to %[[VAL_52]] : !fir.ref<!fir.logical<4>>
+! CHECK:         fir.call @_QPprint_parent_component1(%[[VAL_1]]) : (!fir.ref<!fir.type<_QFtest_parent_component1Tmid{x:i32,y:!fir.array<2xi32>,mask:!fir.logical<4>}>>) -> ()
+! CHECK:         return
+! CHECK:       }
+
+subroutine test_parent_component1()
+  type base
+    integer :: x, y(2)
+  end type base
+  type, extends(base) :: mid
+    logical :: mask
+  end type mid
+
+  call print_parent_component1(mid(base = base(1, [2, 3]), mask = .true.))
+end
+
+! CHECK-LABEL: func.func @_QPtest_parent_component2() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.type<_QFtest_parent_component2Tmid{z:!fir.char<1,5>,mask:!fir.logical<4>}>
+! CHECK:         %[[VAL_1:.*]] = fir.address_of(@_QFtest_parent_component2Epv) : !fir.ref<!fir.type<_QFtest_parent_component2Tbase{z:!fir.char<1,5>}>>
+! CHECK:         %[[VAL_8:.*]] = fir.field_index z, !fir.type<_QFtest_parent_component2Tbase{z:!fir.char<1,5>}>
+! CHECK:         %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_8]] : (!fir.ref<!fir.type<_QFtest_parent_component2Tbase{z:!fir.char<1,5>}>>, !fir.field) -> !fir.ref<!fir.char<1,5>>
+! CHECK:         %[[VAL_10:.*]] = fir.field_index z, !fir.type<_QFtest_parent_component2Tmid{z:!fir.char<1,5>,mask:!fir.logical<4>}>
+! CHECK:         %[[VAL_11:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_10]] : (!fir.ref<!fir.type<_QFtest_parent_component2Tmid{z:!fir.char<1,5>,mask:!fir.logical<4>}>>, !fir.field) -> !fir.ref<!fir.char<1,5>>
+! CHECK:         %[[VAL_12:.*]] = arith.constant 5 : index
+! CHECK:         %[[VAL_13:.*]] = arith.constant 1 : i64
+! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_12]] : (index) -> i64
+! CHECK:         %[[VAL_15:.*]] = arith.muli %[[VAL_13]], %[[VAL_14]] : i64
+! CHECK:         %[[VAL_16:.*]] = arith.constant false
+! CHECK:         %[[VAL_17:.*]] = fir.convert %[[VAL_11]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8>
+! CHECK:         %[[VAL_18:.*]] = fir.convert %[[VAL_9]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8>
+! CHECK:         fir.call @llvm.memmove.p0.p0.i64(%[[VAL_17]], %[[VAL_18]], %[[VAL_15]], %[[VAL_16]]) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+! CHECK:         %[[VAL_19:.*]] = fir.field_index mask, !fir.type<_QFtest_parent_component2Tmid{z:!fir.char<1,5>,mask:!fir.logical<4>}>
+! CHECK:         %[[VAL_20:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_19]] : (!fir.ref<!fir.type<_QFtest_parent_component2Tmid{z:!fir.char<1,5>,mask:!fir.logical<4>}>>, !fir.field) -> !fir.ref<!fir.logical<4>>
+! CHECK:         %[[VAL_21:.*]] = arith.constant true
+! CHECK:         %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i1) -> !fir.logical<4>
+! CHECK:         fir.store %[[VAL_22]] to %[[VAL_20]] : !fir.ref<!fir.logical<4>>
+! CHECK:         fir.call @_QPprint_parent_component2(%[[VAL_0]]) : (!fir.ref<!fir.type<_QFtest_parent_component2Tmid{z:!fir.char<1,5>,mask:!fir.logical<4>}>>) -> ()
+! CHECK:         return
+! CHECK:       }
+
+subroutine test_parent_component2()
+  type base
+    character(5) :: z
+  end type base
+  type, extends(base) :: mid
+    logical :: mask
+  end type mid
+  type(base) :: pv = base("aaa")
+
+  call print_parent_component2(mid(base = pv, mask = .true.))
+end
+
+! CHECK-LABEL: func.func @_QPtest_parent_component3(
+! CHECK-SAME:                                       %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>>> {fir.bindc_name = "pp"}) {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>
+! CHECK:         %[[VAL_2:.*]] = fir.alloca !fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>
+! CHECK:         %[[VAL_3:.*]] = fir.alloca !fir.type<_QFtest_parent_component3Tmid{m:!fir.array<2x!fir.char<1,5>>,mask:!fir.logical<4>}>
+! CHECK:         %[[VAL_10:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>>>
+! CHECK:         %[[VAL_11:.*]] = fir.embox %[[VAL_2]] : (!fir.ref<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>) -> !fir.box<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>
+! CHECK:         fir.store %[[VAL_11]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>>
+! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.box<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>>) -> !fir.ref<!fir.box<none>>
+! CHECK:         %[[VAL_15:.*]] = fir.convert %[[VAL_10]] : (!fir.box<!fir.ptr<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>>) -> !fir.box<none>
+! CHECK:         %[[VAL_17:.*]] = fir.call @_FortranAAssign(%[[VAL_14]], %[[VAL_15]], %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK:         %[[VAL_18:.*]] = fir.field_index m, !fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>
+! CHECK:         %[[VAL_19:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_18]] : (!fir.ref<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>, !fir.field) -> !fir.ref<!fir.array<2x!fir.char<1,5>>>
+! CHECK:         %[[VAL_20:.*]] = fir.field_index m, !fir.type<_QFtest_parent_component3Tmid{m:!fir.array<2x!fir.char<1,5>>,mask:!fir.logical<4>}>
+! CHECK:         %[[VAL_21:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_20]] : (!fir.ref<!fir.type<_QFtest_parent_component3Tmid{m:!fir.array<2x!fir.char<1,5>>,mask:!fir.logical<4>}>>, !fir.field) -> !fir.ref<!fir.array<2x!fir.char<1,5>>>
+! CHECK:         %[[VAL_22:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_23:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_24:.*]] = arith.constant 1 : index
+! CHECK:         fir.do_loop %[[VAL_25:.*]] = %[[VAL_22]] to %[[VAL_24]] step %[[VAL_23]] {
+! CHECK:           %[[VAL_26:.*]] = fir.coordinate_of %[[VAL_21]], %[[VAL_25]] : (!fir.ref<!fir.array<2x!fir.char<1,5>>>, index) -> !fir.ref<!fir.char<1,5>>
+! CHECK:           %[[VAL_27:.*]] = fir.coordinate_of %[[VAL_19]], %[[VAL_25]] : (!fir.ref<!fir.array<2x!fir.char<1,5>>>, index) -> !fir.ref<!fir.char<1,5>>
+! CHECK:           %[[VAL_28:.*]] = arith.constant 5 : index
+! CHECK:           %[[VAL_29:.*]] = arith.constant 1 : i64
+! CHECK:           %[[VAL_30:.*]] = fir.convert %[[VAL_28]] : (index) -> i64
+! CHECK:           %[[VAL_31:.*]] = arith.muli %[[VAL_29]], %[[VAL_30]] : i64
+! CHECK:           %[[VAL_32:.*]] = arith.constant false
+! CHECK:           %[[VAL_33:.*]] = fir.convert %[[VAL_26]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8>
+! CHECK:           %[[VAL_34:.*]] = fir.convert %[[VAL_27]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8>
+! CHECK:           fir.call @llvm.memmove.p0.p0.i64(%[[VAL_33]], %[[VAL_34]], %[[VAL_31]], %[[VAL_32]]) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+! CHECK:         }
+! CHECK:         %[[VAL_35:.*]] = fir.field_index mask, !fir.type<_QFtest_parent_component3Tmid{m:!fir.array<2x!fir.char<1,5>>,mask:!fir.logical<4>}>
+! CHECK:         %[[VAL_36:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_35]] : (!fir.ref<!fir.type<_QFtest_parent_component3Tmid{m:!fir.array<2x!fir.char<1,5>>,mask:!fir.logical<4>}>>, !fir.field) -> !fir.ref<!fir.logical<4>>
+! CHECK:         %[[VAL_37:.*]] = arith.constant true
+! CHECK:         %[[VAL_38:.*]] = fir.convert %[[VAL_37]] : (i1) -> !fir.logical<4>
+! CHECK:         fir.store %[[VAL_38]] to %[[VAL_36]] : !fir.ref<!fir.logical<4>>
+! CHECK:         fir.call @_QPprint_parent_component3(%[[VAL_3]]) : (!fir.ref<!fir.type<_QFtest_parent_component3Tmid{m:!fir.array<2x!fir.char<1,5>>,mask:!fir.logical<4>}>>) -> ()
+! CHECK:         return
+! CHECK:       }
+
+subroutine test_parent_component3(pp)
+  type base
+    character(5) :: m(2)
+  end type base
+  type, extends(base) :: mid
+    logical :: mask
+  end type mid
+  type(base), pointer :: pp
+
+  call print_parent_component3(mid(base = pp, mask = .true.))
+end