diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -163,14 +163,65 @@ } fir::FortranVariableOpInterface - gen(const Fortran::evaluate::Component &component) { + gen(const Fortran::evaluate::Component &component, + bool skipParentComponent = false) { if (Fortran::semantics::IsAllocatableOrPointer(component.GetLastSymbol())) return genWholeAllocatableOrPointerComponent(component); + if (component.GetLastSymbol().test( + Fortran::semantics::Symbol::Flag::ParentComp)) { + if (skipParentComponent) + // Inner parent components can be skipped: x%parent_comp%i is equivalent + // to "x%i" in FIR (all the parent components are part of the FIR type + // of "x"). + return genDataRefAndSkipParentComponents(component.base()); + // This is a leaf "x%parent_comp" or "x(subscripts)%parent_comp" and + // cannot be skipped: the designator must be lowered to the parent type. + // This cannot be represented with an hlfir.designate since "parent_comp" + // name is meaningless in the fir.record type of "x". Instead, an + // hlfir.parent_comp is generated. + fir::FirOpBuilder &builder = getBuilder(); + hlfir::Entity base = genDataRefAndSkipParentComponents(component.base()); + base = derefPointersAndAllocatables(loc, builder, base); + mlir::Value shape; + if (base.isArray()) + shape = hlfir::genShape(loc, builder, base); + const Fortran::semantics::DeclTypeSpec *declTypeSpec = + component.GetLastSymbol().GetType(); + assert(declTypeSpec && declTypeSpec->AsDerived() && + "parent component symbols must have a derived type"); + mlir::Type componentType = Fortran::lower::translateDerivedTypeToFIRType( + getConverter(), *declTypeSpec->AsDerived()); + mlir::Type resultType = + changeElementType(base.getElementOrSequenceType(), componentType); + // Note that the result is monomorphic even if the base is polymorphic: + // the dynamic type of the parent component reference is the parent type. + // If the base is an array, it is however most likely not contiguous. + if (base.isArray() || fir::isRecordWithTypeParameters(componentType)) + resultType = fir::BoxType::get(resultType); + else + resultType = fir::ReferenceType::get(resultType); + if (fir::isRecordWithTypeParameters(componentType)) + TODO(loc, "parent component reference with a parametrized parent type"); + auto parentComp = builder.create( + loc, resultType, base, shape, /*typeParams=*/mlir::ValueRange{}); + return mlir::cast( + parentComp.getOperation()); + } PartInfo partInfo; mlir::Type resultType = visit(component, partInfo); return genDesignate(resultType, partInfo, component); } + fir::FortranVariableOpInterface + genDataRefAndSkipParentComponents(const Fortran::evaluate::DataRef &dataRef) { + return std::visit(Fortran::common::visitors{ + [&](const Fortran::evaluate::Component &component) { + return gen(component, /*skipParentComponent=*/true); + }, + [&](const auto &x) { return gen(x); }}, + dataRef.u); + } + fir::FortranVariableOpInterface gen(const Fortran::evaluate::ArrayRef &arrayRef) { PartInfo partInfo; @@ -508,8 +559,7 @@ // coarray-ref, or another component, this creates another hlfir.designate // for it. hlfir.designate is not meant to represent more than one // part-ref. - partInfo.base = - std::visit([&](const auto &x) { return gen(x); }, component.base().u); + partInfo.base = genDataRefAndSkipParentComponents(component.base()); // If the base is an allocatable/pointer, dereference it here since the // component ref designates its target. partInfo.base = @@ -523,8 +573,9 @@ // Lower the information about the component (type, length parameters and // shape). const Fortran::semantics::Symbol &componentSym = component.GetLastSymbol(); - if (componentSym.test(Fortran::semantics::Symbol::Flag::ParentComp)) - TODO(getLoc(), "Parent component reference in HLFIR"); + assert( + !componentSym.test(Fortran::semantics::Symbol::Flag::ParentComp) && + "parent components are skipped and must not reach visitComponentImpl"); partInfo.componentName = componentSym.name().ToString(); auto recordType = hlfir::getFortranElementType(baseType).cast(); diff --git a/flang/test/Lower/HLFIR/parent-component-ref.f90 b/flang/test/Lower/HLFIR/parent-component-ref.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/HLFIR/parent-component-ref.f90 @@ -0,0 +1,99 @@ +! Test lowering of parent component references to HLFIR. +! RUN: bbc -emit-fir -hlfir -polymorphic-type -o - %s -I nw | FileCheck %s + +module pc_types + type t + integer :: i + end type + type, extends(t) :: t2 + integer :: j + end type +interface +subroutine takes_t_type_array(x) + import :: t + type(t) :: x(:) +end subroutine +subroutine takes_t_class_array(x) + import :: t + class(t) :: x(:) +end subroutine +subroutine takes_int_array(x) + integer :: x(:) +end subroutine +end interface +end module + +subroutine test_ignored_inner_parent_comp(x) + use pc_types + type(t2) :: x + call takes_int(x%t%i) +end subroutine +! CHECK-LABEL: func.func @_QPtest_ignored_inner_parent_comp( +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex" +! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"i"} : (!fir.ref>) -> !fir.ref +! CHECK: fir.call @_QPtakes_int(%[[VAL_2]]) + +subroutine test_ignored_inner_parent_comp_2(x) + use pc_types + type(t2) :: x(:) + call takes_int_array(x%t%i) +end subroutine +! CHECK-LABEL: func.func @_QPtest_ignored_inner_parent_comp_2( +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex" +! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_1]]#0, %[[VAL_2]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_5:.*]] = hlfir.designate %[[VAL_1]]#0{"i"} shape %[[VAL_4]] : (!fir.box>>, !fir.shape<1>) -> !fir.box> +! CHECK: fir.call @_QPtakes_int_array(%[[VAL_5]]) + +subroutine test_leaf_parent_ref(x) + use pc_types + type(t2) :: x + call takes_parent(x%t) +end subroutine +! CHECK-LABEL: func.func @_QPtest_leaf_parent_ref( +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex" +! CHECK: %[[VAL_2:.*]] = hlfir.parent_comp %[[VAL_1]]#0 : (!fir.ref>) -> !fir.ref> +! CHECK: fir.call @_QPtakes_parent(%[[VAL_2]]) + +subroutine test_leaf_parent_ref_array(x) + use pc_types + class(t2) :: x(42:) +! CHECK-LABEL: func.func @_QPtest_leaf_parent_ref_array( +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare {{.*}}Ex" + call takes_t_type_array(x%t) +! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_4]]#0, %[[VAL_5]] : (!fir.class>>, index) -> (index, index, index) +! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_6]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_8:.*]] = hlfir.parent_comp %[[VAL_4]]#0 shape %[[VAL_7]] : (!fir.class>>, !fir.shape<1>) -> !fir.box>> +! CHECK: fir.call @_QPtakes_t_type_array(%[[VAL_8]]) + call takes_t_class_array(x%t) +! CHECK: %[[VAL_12:.*]] = hlfir.parent_comp %[[VAL_4]]#0 shape %{{.*}} : (!fir.class>>, !fir.shape<1>) -> !fir.box>> +! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (!fir.box>>) -> !fir.class>> +! CHECK: fir.call @_QPtakes_t_class_array(%[[VAL_13]]) +end subroutine + +subroutine test_parent_section_leaf_array(x) + use pc_types + class(t2) :: x(:) + call takes_t_type_array(x(2:11)%t) +end subroutine +! CHECK-LABEL: func.func @_QPtest_parent_section_leaf_array( +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex" +! CHECK: %[[VAL_7:.*]] = hlfir.designate %[[VAL_1]]#0 ({{.*}}) shape %[[VAL_6:.*]] : (!fir.class>>, index, index, index, !fir.shape<1>) -> !fir.class>> +! CHECK: %[[VAL_8:.*]] = hlfir.parent_comp %[[VAL_7]] shape %[[VAL_6]] : (!fir.class>>, !fir.shape<1>) -> !fir.box>> +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.box>>) -> !fir.box>> +! CHECK: fir.call @_QPtakes_t_type_array(%[[VAL_9]]) + +subroutine test_pointer_leaf_parent_ref_array(x) + use pc_types + class(t2), pointer :: x(:) + call takes_t_type_array(x%t) +end subroutine +! CHECK-LABEL: func.func @_QPtest_pointer_leaf_parent_ref_array( +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex" +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref>>>> +! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_4:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_3]] : (!fir.class>>>, index) -> (index, index, index) +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_6:.*]] = hlfir.parent_comp %[[VAL_2]] shape %[[VAL_5]] : (!fir.class>>>, !fir.shape<1>) -> !fir.box>>