[flang-commits] [flang] ed642d2 - [flang] Handle parent component of extended derived-type
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Wed Sep 21 02:20:28 PDT 2022
Author: Valentin Clement
Date: 2022-09-21T11:20:14+02:00
New Revision: ed642d2064b8dbe8641f1e3f576e4817aa71680a
URL: https://github.com/llvm/llvm-project/commit/ed642d2064b8dbe8641f1e3f576e4817aa71680a
DIFF: https://github.com/llvm/llvm-project/commit/ed642d2064b8dbe8641f1e3f576e4817aa71680a.diff
LOG: [flang] Handle parent component of extended derived-type
Parent component refers to the parent derived-type of an extended type.
The parent component is skipped when a specififc component is
referred to. This is fine since all the components in extended type
are available in the type itself. When the parent component is referred,
it need to be taken into account correctly.
This patch fixes the case when the parent component is referred. In a
box, an approriate slice is created or updated to point to the first
component of the parent component. For scalar, a simple conversion to
the parent component type is done.
Reviewed By: jeanPerier
Differential Revision: https://reviews.llvm.org/D134170
Added:
flang/test/Lower/parent-component.f90
Modified:
flang/lib/Lower/ConvertExpr.cpp
Removed:
################################################################################
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 91f2327aa547d..51f77ffa26c50 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -1903,6 +1903,9 @@ class ScalarExprLowering {
loc, fldTy, name, recTy, fir::getTypeParams(obj)));
ty = recTy.getType(name);
}
+ // If parent component is referred then it has no coordinate argument.
+ if (coorArgs.size() == 0)
+ return obj;
ty = builder.getRefType(ty);
return fir::factory::componentToExtendedValue(
builder, loc,
@@ -7743,16 +7746,115 @@ fir::MutableBoxValue Fortran::lower::createMutableBox(
.genMutableBoxValue(expr);
}
+bool isParentComponent(const Fortran::lower::SomeExpr &expr) {
+ if (const Fortran::semantics::Symbol * symbol{GetLastSymbol(expr)}) {
+ if (symbol->test(Fortran::semantics::Symbol::Flag::ParentComp))
+ return true;
+ }
+ return false;
+}
+
+template <typename OP>
+mlir::Value createSliceForParentComp(fir::FirOpBuilder &builder,
+ mlir::Location loc, OP boxOp,
+ fir::ExtendedValue box, mlir::Value field,
+ bool isArray) {
+ if (boxOp.getSlice()) {
+ mlir::Value existingSlice = boxOp.getSlice();
+ fir::SliceOp sliceOp =
+ mlir::dyn_cast<fir::SliceOp>(existingSlice.getDefiningOp());
+ llvm::SmallVector<mlir::Value> fields = sliceOp.getFields();
+ fields.push_back(field);
+ return builder.createSlice(loc, box, sliceOp.getTriples(), fields);
+ }
+ if (isArray)
+ return builder.createSlice(loc, box, {}, {field});
+ return {};
+}
+
+// Handling special case where the last component is referring to the
+// parent component.
+//
+// TYPE t
+// integer :: a
+// END TYPE
+// TYPE, EXTENDS(t) :: t2
+// integer :: b
+// END TYPE
+// TYPE(t2) :: y(2)
+// TYPE(t2) :: a
+// y(:)%t ! just need to update the box with a slice pointing to the first
+// ! component of `t`.
+// a%t ! simple conversion to TYPE(t).
+fir::ExtendedValue
+updateBoxForParentComponent(Fortran::lower::AbstractConverter &converter,
+ fir::ExtendedValue box,
+ const Fortran::lower::SomeExpr &expr) {
+ mlir::Location loc = converter.getCurrentLocation();
+ auto &builder = converter.getFirOpBuilder();
+ mlir::Value boxBase = fir::getBase(box);
+ mlir::Operation *op = boxBase.getDefiningOp();
+ fir::BoxType boxTy = boxBase.getType().dyn_cast<fir::BoxType>();
+ mlir::Type boxEleTy = fir::unwrapAllRefAndSeqType(boxTy.getEleTy());
+ auto originalRecTy = boxEleTy.dyn_cast<fir::RecordType>();
+ mlir::Type actualTy = converter.genType(expr);
+ mlir::Type eleTy = fir::unwrapAllRefAndSeqType(actualTy);
+ auto parentCompTy = eleTy.dyn_cast<fir::RecordType>();
+ assert(parentCompTy && "expecting derived-type");
+
+ assert(
+ (mlir::dyn_cast<fir::EmboxOp>(op) || mlir::dyn_cast<fir::ReboxOp>(op)) &&
+ "expecting fir.embox or fir.rebox operation");
+
+ if (parentCompTy.getTypeList().empty())
+ TODO(loc, "parent component with no component");
+
+ // Creating a slice with a path to the first component of the parent component
+ // of the extended type.
+ auto firstComponent = parentCompTy.getTypeList().front();
+ auto fieldTy = fir::FieldType::get(boxTy.getContext());
+ auto field = builder.create<fir::FieldIndexOp>(
+ loc, fieldTy, firstComponent.first, originalRecTy,
+ /*typeParams=*/mlir::ValueRange{});
+
+ if (auto embox = mlir::dyn_cast<fir::EmboxOp>(op)) {
+ mlir::Value slice = createSliceForParentComp(builder, loc, embox, box,
+ field, expr.Rank() > 0);
+ auto newBox = builder.create<fir::EmboxOp>(
+ loc, fir::BoxType::get(actualTy), embox.getMemref(), embox.getShape(),
+ slice, embox.getTypeparams());
+ return fir::substBase(box, fir::getBase(newBox));
+ }
+ if (auto rebox = mlir::dyn_cast<fir::ReboxOp>(op)) {
+ mlir::Value slice = createSliceForParentComp(builder, loc, rebox, box,
+ field, expr.Rank() > 0);
+ auto newBox =
+ builder.create<fir::ReboxOp>(loc, fir::BoxType::get(actualTy),
+ rebox.getBox(), rebox.getShape(), slice);
+ return fir::substBase(box, fir::getBase(newBox));
+ }
+ return box;
+}
+
fir::ExtendedValue Fortran::lower::createBoxValue(
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
Fortran::lower::StatementContext &stmtCtx) {
if (expr.Rank() > 0 && Fortran::evaluate::IsVariable(expr) &&
- !Fortran::evaluate::HasVectorSubscript(expr))
- return Fortran::lower::createSomeArrayBox(converter, expr, symMap, stmtCtx);
+ !Fortran::evaluate::HasVectorSubscript(expr)) {
+ fir::ExtendedValue result =
+ Fortran::lower::createSomeArrayBox(converter, expr, symMap, stmtCtx);
+ if (isParentComponent(expr))
+ result = updateBoxForParentComponent(converter, result, expr);
+ return result;
+ }
fir::ExtendedValue addr = Fortran::lower::createSomeExtendedAddress(
loc, converter, expr, symMap, stmtCtx);
- return fir::BoxValue(converter.getFirOpBuilder().createBox(loc, addr));
+ fir::ExtendedValue result =
+ fir::BoxValue(converter.getFirOpBuilder().createBox(loc, addr));
+ if (isParentComponent(expr))
+ result = updateBoxForParentComponent(converter, result, expr);
+ return result;
}
mlir::Value Fortran::lower::createSubroutineCall(
diff --git a/flang/test/Lower/parent-component.f90 b/flang/test/Lower/parent-component.f90
new file mode 100644
index 0000000000000..85490ee437da7
--- /dev/null
+++ b/flang/test/Lower/parent-component.f90
@@ -0,0 +1,219 @@
+! Test
diff erent ways of passing the parent component of an extended
+! derived-type to a subroutine or the runtime.
+
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+program parent_comp
+ type p
+ integer :: a
+ end type
+
+ type, extends(p) :: c
+ integer :: b
+ end type
+
+ type z
+ integer :: k
+ type(c) :: c
+ end type
+
+ type(c) :: t(2) = [ c(11, 21), c(12, 22) ]
+ call init_with_slice()
+ call init_no_slice()
+ call init_allocatable()
+ call init_scalar()
+ call init_assumed(t)
+contains
+
+ subroutine print_scalar(a)
+ type(p), intent(in) :: a
+ print*, a
+ end subroutine
+ ! CHECK-LABEL: func.func @_QFPprint_scalar(%{{.*}}: !fir.ref<!fir.type<_QFTp{a:i32}>> {fir.bindc_name = "a"})
+
+ subroutine print_p(a)
+ type(p), intent(in) :: a(2)
+ print*, a
+ end subroutine
+ ! CHECK-LABEL: func.func @_QFPprint_p(%{{.*}}: !fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>> {fir.bindc_name = "a"})
+
+ subroutine init_with_slice()
+ type(c) :: y(2) = [ c(11, 21), c(12, 22) ]
+ call print_p(y(:)%p)
+ print*,y(:)%p
+ end subroutine
+ ! CHECK-LABEL: func.func @_QFPinit_with_slice()
+ ! CHECK: %[[Y:.*]] = fir.address_of(@_QFinit_with_sliceEy) : !fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>
+ ! CHECK: %[[C2:.*]] = arith.constant 2 : index
+ ! CHECK: %[[C1:.*]] = arith.constant 1 : index
+ ! CHECK: %[[C1_I64:.*]] = arith.constant 1 : i64
+ ! CHECK: %[[STRIDE:.*]] = fir.convert %[[C1_I64]] : (i64) -> index
+ ! CHECK: %[[ADD:.*]] = arith.addi %[[C1]], %[[C2]] : index
+ ! CHECK: %[[UB:.*]] = arith.subi %[[ADD]], %[[C1]] : index
+ ! CHECK: %[[SHAPE:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1>
+ ! CHECK: %[[FIELD:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
+ ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[UB]], %[[STRIDE]] path %[[FIELD]] : (index, index, index, !fir.field) -> !fir.slice<1>
+ ! CHECK: %[[BOX:.*]] = fir.embox %[[Y]](%[[SHAPE]]) [%[[SLICE]]] : (!fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>
+ ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> !fir.box<none>
+ ! CHECK: %[[IS_CONTIGOUS:.*]] = fir.call @_FortranAIsContiguous(%[[BOX_NONE]]) : (!fir.box<none>) -> i1
+ ! CHECK: %[[TEMP:.*]] = fir.if %[[IS_CONTIGOUS]] -> (!fir.heap<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) {
+ ! CHECK: } else {
+ ! CHECK: %{{.*}} = fir.do_loop %{{.*}} = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%{{.*}} = %{{.*}}) -> (!fir.array<2x!fir.type<_QFTp{a:i32}>>)
+ ! CHECK: %{{.*}} = fir.field_index a, !fir.type<_QFTp{a:i32}>
+ ! CHECK-NOT: %{{.*}} = fir.field_index b, !fir.type<_QFTp{a:i32}>
+ ! CHECK: %[[TEMP_CAST:.*]] = fir.convert %[[TEMP]] : (!fir.heap<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> !fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>>
+ ! CHECK: fir.call @_QFPprint_p(%[[TEMP_CAST]]) : (!fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> ()
+
+ ! CHECK-LABEL: %{{.*}} = fir.call @_FortranAioBeginExternalListOutput(%{{.*}}, %{{.*}}, %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[C1:.*]] = arith.constant 1 : index
+ ! CHECK: %[[C1_I64:.*]] = arith.constant 1 : i64
+ ! CHECK: %[[STRIDE:.*]] = fir.convert %[[C1_I64]] : (i64) -> index
+ ! CHECK: %[[ADD:.*]] = arith.addi %[[C1]], %[[C2]] : index
+ ! CHECK: %[[UB:.*]] = arith.subi %[[ADD]], %[[C1]] : index
+ ! CHECK: %[[SHAPE:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1>
+ ! CHECK: %[[FIELD:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
+ ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[UB]], %[[STRIDE]] path %[[FIELD]] : (index, index, index, !fir.field) -> !fir.slice<1>
+ ! CHECK: %[[BOX:.*]] = fir.embox %[[Y]](%[[SHAPE]]) [%[[SLICE]]] : (!fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>
+ ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> !fir.box<none>
+ ! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) : (!fir.ref<i8>, !fir.box<none>) -> i1
+
+ subroutine init_no_slice()
+ type(c) :: y(2) = [ c(11, 21), c(12, 22) ]
+ call print_p(y%p)
+ print*,y%p
+ end subroutine
+ ! CHECK-LABEL: func.func @_QFPinit_no_slice()
+ ! CHECK: %[[Y:.*]] = fir.address_of(@_QFinit_no_sliceEy) : !fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>
+ ! CHECK: %[[C2:.*]] = arith.constant 2 : index
+ ! CHECK: %[[SHAPE:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1>
+ ! CHECK: %[[FIELD:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
+ ! CHECK: %[[C0:.*]] = arith.constant 0 : index
+ ! CHECK: %[[BOX_DIM:.*]]:3 = fir.box_dims %{{.*}}, %[[C0]] : (!fir.box<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>, index) -> (index, index, index)
+ ! CHECK: %[[C1:.*]] = arith.constant 1 : index
+ ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIM]]#1, %[[C1]] path %[[FIELD]] : (index, index, index, !fir.field) -> !fir.slice<1>
+ ! CHECK: %[[BOX:.*]] = fir.embox %[[Y]](%[[SHAPE]]) [%[[SLICE]]] : (!fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>
+ ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> !fir.box<none>
+ ! CHECK: %[[IS_CONTIGOUS:.*]] = fir.call @_FortranAIsContiguous(%[[BOX_NONE]]) : (!fir.box<none>) -> i1
+ ! CHECK: %[[TEMP:.*]] = fir.if %[[IS_CONTIGOUS]] -> (!fir.heap<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) {
+ ! CHECK: } else {
+ ! CHECK: %{{.*}} = fir.do_loop %{{.*}} = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%{{.*}} = %{{.*}}) -> (!fir.array<2x!fir.type<_QFTp{a:i32}>>)
+ ! CHECK: %{{.*}} = fir.field_index a, !fir.type<_QFTp{a:i32}>
+ ! CHECK-NOT: %{{.*}} = fir.field_index b, !fir.type<_QFTp{a:i32}>
+ ! CHECK: %[[TEMP_CAST:.*]] = fir.convert %[[TEMP]] : (!fir.heap<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> !fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>>
+ ! CHECK: fir.call @_QFPprint_p(%[[TEMP_CAST]]) : (!fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> ()
+
+ ! CHECK-LABEL: %{{.*}} = fir.call @_FortranAioBeginExternalListOutput(%{{.*}}, %{{.*}}, %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[SHAPE:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1>
+ ! CHECK: %[[FIELD:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
+ ! CHECK: %[[C0:.*]] = arith.constant 0 : index
+ ! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %{{.*}}, %[[C0]] : (!fir.box<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>, index) -> (index, index, index)
+ ! CHECK: %[[C1:.*]] = arith.constant 1 : index
+ ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD]] : (index, index, index, !fir.field) -> !fir.slice<1>
+ ! CHECK: %[[BOX:.*]] = fir.embox %[[Y]](%[[SHAPE]]) [%[[SLICE]]] : (!fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>
+ ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> !fir.box<none>
+ ! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) : (!fir.ref<i8>, !fir.box<none>) -> i1
+
+ subroutine init_allocatable()
+ type(c), allocatable :: y(:)
+ allocate(y(2))
+ y(1) = c(11, 21)
+ y(2) = c(12, 22)
+ call print_p(y%p)
+ print*,y%p
+ end subroutine
+
+ ! CHECK-LABEL: func.func @_QFPinit_allocatable()
+ ! CHECK: %[[ALLOC:.*]] = fir.alloca !fir.heap<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>> {uniq_name = "_QFinit_allocatableEy.addr"}
+ ! CHECK: %[[LB0:.*]] = fir.alloca index {uniq_name = "_QFinit_allocatableEy.lb0"}
+ ! CHECK: %[[EXT0:.*]] = fir.alloca index {uniq_name = "_QFinit_allocatableEy.ext0"}
+ ! CHECK-COUNT-6: %{{.*}} = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
+ ! CHECK: %[[LOAD_LB0:.*]] = fir.load %[[LB0]] : !fir.ref<index>
+ ! CHECK: %[[LOAD_EXT0:.*]] = fir.load %[[EXT0]] : !fir.ref<index>
+ ! CHECK: %[[MEM:.*]] = fir.load %[[ALLOC]] : !fir.ref<!fir.heap<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>>
+ ! CHECK: %[[SHAPE_SHIFT:.*]] = fir.shape_shift %[[LOAD_LB0]], %[[LOAD_EXT0]] : (index, index) -> !fir.shapeshift<1>
+ ! CHECK: %[[FIELD:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
+ ! CHECK: %[[C0:.*]] = arith.constant 0 : index
+ ! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %{{.*}}, %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>, index) -> (index, index, index)
+ ! CHECK: %[[C1:.*]] = arith.constant 1 : index
+ ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD]] : (index, index, index, !fir.field) -> !fir.slice<1>
+ ! CHECK: %[[BOX:.*]] = fir.embox %[[MEM]](%[[SHAPE_SHIFT]]) [%[[SLICE]]] : (!fir.heap<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box<!fir.array<?x!fir.type<_QFTp{a:i32}>>>
+ ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!fir.box<!fir.array<?x!fir.type<_QFTp{a:i32}>>>) -> !fir.box<none>
+ ! CHECK: %[[IS_CONTIGOUS:.*]] = fir.call @_FortranAIsContiguous(%[[BOX_NONE]]) : (!fir.box<none>) -> i1
+ ! CHECK: %[[TEMP:.*]] = fir.if %[[IS_CONTIGOUS]] -> (!fir.heap<!fir.array<?x!fir.type<_QFTp{a:i32}>>>) {
+ ! CHECK: } else {
+ ! CHECK: %{{.*}} = fir.do_loop %{{.*}} = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%{{.*}} = %{{.*}}) -> (!fir.array<?x!fir.type<_QFTp{a:i32}>>)
+ ! CHECK: %{{.*}} = fir.field_index a, !fir.type<_QFTp{a:i32}>
+ ! CHECK-NOT: %{{.*}} = fir.field_index b, !fir.type<_QFTp{a:i32}>
+ ! CHECK: %[[TEMP_CAST:.*]] = fir.convert %[[TEMP]] : (!fir.heap<!fir.array<?x!fir.type<_QFTp{a:i32}>>>) -> !fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>>
+ ! CHECK: fir.call @_QFPprint_p(%[[TEMP_CAST]]) : (!fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> ()
+
+ ! CHECK-LABEL: %{{.*}} = fir.call @_FortranAioBeginExternalListOutput(%{{.*}}, %{{.*}}, %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[LOAD_LB0:.*]] = fir.load %[[LB0]] : !fir.ref<index>
+ ! CHECK: %[[LOAD_EXT0:.*]] = fir.load %[[EXT0]] : !fir.ref<index>
+ ! CHECK: %[[LOAD_ALLOC:.*]] = fir.load %[[ALLOC]] : !fir.ref<!fir.heap<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>>
+ ! CHECK: %[[SHAPE_SHIFT:.*]] = fir.shape_shift %[[LOAD_LB0]], %[[LOAD_EXT0]] : (index, index) -> !fir.shapeshift<1>
+ ! CHECK: %[[FIELD:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
+ ! CHECK: %[[C0:.*]] = arith.constant 0 : index
+ ! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %{{.*}}, %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>, index) -> (index, index, index)
+ ! CHECK: %[[C1:.*]] = arith.constant 1 : index
+ ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD]] : (index, index, index, !fir.field) -> !fir.slice<1>
+ ! CHECK: %[[BOX:.*]] = fir.embox %[[LOAD_ALLOC]](%[[SHAPE_SHIFT]]) [%[[SLICE]]] : (!fir.heap<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box<!fir.array<?x!fir.type<_QFTp{a:i32}>>>
+ ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!fir.box<!fir.array<?x!fir.type<_QFTp{a:i32}>>>) -> !fir.box<none>
+ ! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) : (!fir.ref<i8>, !fir.box<none>) -> i1
+
+ subroutine init_scalar()
+ type(c) :: s = c(11, 21)
+ call print_scalar(s%p)
+ print*,s%p
+ end subroutine
+
+ ! CHECK-LABEL: func.func @_QFPinit_scalar()
+ ! CHECK: %[[S:.*]] = fir.address_of(@_QFinit_scalarEs) : !fir.ref<!fir.type<_QFTc{a:i32,b:i32}>>
+ ! CHECK: %[[CAST:.*]] = fir.convert %[[S]] : (!fir.ref<!fir.type<_QFTc{a:i32,b:i32}>>) -> !fir.ref<!fir.type<_QFTp{a:i32}>>
+ ! CHECK: fir.call @_QFPprint_scalar(%[[CAST]]) : (!fir.ref<!fir.type<_QFTp{a:i32}>>) -> ()
+
+ ! CHECK: %[[BOX:.*]] = fir.embox %{{.*}} : (!fir.ref<!fir.type<_QFTc{a:i32,b:i32}>>) -> !fir.box<!fir.type<_QFTp{a:i32}>>
+ ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!fir.box<!fir.type<_QFTp{a:i32}>>) -> !fir.box<none>
+ ! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) : (!fir.ref<i8>, !fir.box<none>) -> i1
+
+ subroutine init_assumed(y)
+ type(c) :: y(:)
+ call print_p(y%p)
+ print*,y%p
+ end subroutine
+
+ ! CHECK-LABEL: func.func @_QFPinit_assumed(
+ ! CHECK-SAME: %[[ARG0:.*]]: !fir.box<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>
+ ! CHECK: %[[BOX:.*]] = fir.rebox %[[ARG0]] : (!fir.box<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>) -> !fir.box<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>
+ ! CHECK: %[[FIELD:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
+ ! CHECK: %[[C0:.*]] = arith.constant 0 : index
+ ! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[BOX]], %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>, index) -> (index, index, index)
+ ! CHECK: %[[C1:.*]] = arith.constant 1 : index
+ ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD]] : (index, index, index, !fir.field) -> !fir.slice<1>
+ ! CHECK: %{{.*}} = fir.rebox %[[ARG0]] [%[[SLICE]]] : (!fir.box<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>, !fir.slice<1>) -> !fir.box<!fir.array<?x!fir.type<_QFTp{a:i32}>>>
+
+ ! CHECK: %[[BOX:.*]] = fir.rebox %[[ARG0]] : (!fir.box<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>) -> !fir.box<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>
+ ! CHECK: %[[FIELD:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
+ ! CHECK: %[[C0:.*]] = arith.constant 0 : index
+ ! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %13, %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>, index) -> (index, index, index)
+ ! CHECK: %[[C1:.*]] = arith.constant 1 : index
+ ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD]] : (index, index, index, !fir.field) -> !fir.slice<1>
+ ! CHECK: %[[REBOX:.*]] = fir.rebox %arg0 [%[[SLICE]]] : (!fir.box<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>, !fir.slice<1>) -> !fir.box<!fir.array<?x!fir.type<_QFTp{a:i32}>>>
+ ! CHECK: %[[REBOX_CAST:.*]] = fir.convert %[[REBOX]] : (!fir.box<!fir.array<?x!fir.type<_QFTp{a:i32}>>>) -> !fir.box<none>
+ ! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[REBOX_CAST]]) : (!fir.ref<i8>, !fir.box<none>) -> i1
+
+ subroutine init_existing_field()
+ type(z) :: y(2)
+ call print_p(y%c%p)
+ end subroutine
+
+ ! CHECK-LABEL: func.func @_QFPinit_existing_field
+ ! CHECK: %[[C2:.*]] = arith.constant 2 : index
+ ! CHECK: %[[ALLOCA:.*]] = fir.alloca !fir.array<2x!fir.type<_QFTz{k:i32,c:!fir.type<_QFTc{a:i32,b:i32}>}>> {bindc_name = "y", uniq_name = "_QFinit_existing_fieldEy"}
+ ! CHECK: %[[FIELD_C:.*]] = fir.field_index c, !fir.type<_QFTz{k:i32,c:!fir.type<_QFTc{a:i32,b:i32}>}>
+ ! CHECK: %[[SHAPE:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1>
+ ! CHECK: %[[C1:.*]] = arith.constant 1 : index
+ ! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
+ ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[C2]], %[[C1]] path %[[FIELD_C]], %[[FIELD_A]] : (index, index, index, !fir.field, !fir.field) -> !fir.slice<1>
+ ! CHECK: %{{.*}} = fir.embox %[[ALLOCA]](%[[SHAPE]]) [%[[SLICE]]] : (!fir.ref<!fir.array<2x!fir.type<_QFTz{k:i32,c:!fir.type<_QFTc{a:i32,b:i32}>}>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>
+end
More information about the flang-commits
mailing list