From: Valentin Clement Date: Thu, 15 Dec 2022 11:02:11 +0000 (+0100) Subject: [flang] Fix associating entity when selector is an array, pointer or allocatable X-Git-Tag: upstream/17.0.6~23724 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=9379ca0a257780961a7e77c1a56c70d00cd85909;p=platform%2Fupstream%2Fllvm.git [flang] Fix associating entity when selector is an array, pointer or allocatable In SELECT TYPE, within the block following TYPE IS, the associating entity is not polymorphic. It has the type named in the type guard and other properties taken from the selector. Within the block following a CLASS IS type guard statement, the associating entity is polymorphic and has the declared type named in the type guard statement. This patch makes sure the associating entity matches the selector if it is an array, a pointer or an allocatable. Reviewed By: jeanPerier Differential Revision: https://reviews.llvm.org/D140017 --- diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td index 1e29710..088294c 100644 --- a/flang/include/flang/Optimizer/Dialect/FIROps.td +++ b/flang/include/flang/Optimizer/Dialect/FIROps.td @@ -1048,7 +1048,7 @@ def fir_BoxEleSizeOp : fir_SimpleOneResultOp<"box_elesize", [NoMemoryEffect]> { must box an array of REAL values (with dynamic rank and extent). }]; - let arguments = (ins fir_BoxType:$val); + let arguments = (ins BoxOrClassType:$val); let results = (outs AnyIntegerLike); } diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index d2f6353..c58acf8 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2299,6 +2299,12 @@ private: } }; + mlir::Type baseTy = fir::getBase(selector).getType(); + bool isPointer = fir::isPointerType(baseTy); + bool isAllocatable = fir::isAllocatableType(baseTy); + bool isArray = + fir::dyn_cast_ptrOrBoxEleTy(baseTy).isa(); + const fir::BoxValue *selectorBox = selector.getBoxOf(); if (std::holds_alternative(guard.u)) { // CLASS DEFAULT addAssocEntitySymbol(selector); @@ -2308,15 +2314,31 @@ private: fir::ExactTypeAttr attr = typeGuardAttr.dyn_cast(); mlir::Value exactValue; + mlir::Type addrTy = attr.getType(); + if (isArray) { + auto seqTy = fir::dyn_cast_ptrOrBoxEleTy(baseTy) + .dyn_cast(); + addrTy = fir::SequenceType::get(seqTy.getShape(), attr.getType()); + } + if (isPointer) + addrTy = fir::PointerType::get(addrTy); + if (isAllocatable) + addrTy = fir::HeapType::get(addrTy); if (std::holds_alternative( typeSpec->u)) { + mlir::Type refTy = fir::ReferenceType::get(addrTy); + if (isPointer || isAllocatable) + refTy = addrTy; exactValue = builder->create( - loc, fir::ReferenceType::get(attr.getType()), - fir::getBase(selector)); + loc, refTy, fir::getBase(selector)); const Fortran::semantics::IntrinsicTypeSpec *intrinsic = typeSpec->declTypeSpec->AsIntrinsic(); - if (intrinsic->category() == - Fortran::common::TypeCategory::Character) { + if (isArray) { + mlir::Value exact = builder->create( + loc, fir::BoxType::get(addrTy), fir::getBase(selector)); + addAssocEntitySymbol(selectorBox->clone(exact)); + } else if (intrinsic->category() == + Fortran::common::TypeCategory::Character) { auto charTy = attr.getType().dyn_cast(); mlir::Value charLen = fir::factory::CharacterExprHelper(*builder, loc) @@ -2328,16 +2350,31 @@ private: } else if (std::holds_alternative( typeSpec->u)) { exactValue = builder->create( - loc, fir::BoxType::get(attr.getType()), fir::getBase(selector)); - addAssocEntitySymbol(exactValue); + loc, fir::BoxType::get(addrTy), fir::getBase(selector)); + addAssocEntitySymbol(selectorBox->clone(exactValue)); } } else if (std::holds_alternative( guard.u)) { // CLASS IS fir::SubclassAttr attr = typeGuardAttr.dyn_cast(); - mlir::Value derived = builder->create( - loc, fir::ClassType::get(attr.getType()), fir::getBase(selector)); - addAssocEntitySymbol(derived); + mlir::Type addrTy = attr.getType(); + if (isArray) { + auto seqTy = fir::dyn_cast_ptrOrBoxEleTy(baseTy) + .dyn_cast(); + addrTy = fir::SequenceType::get(seqTy.getShape(), attr.getType()); + } + if (isPointer) + addrTy = fir::PointerType::get(addrTy); + if (isAllocatable) + addrTy = fir::HeapType::get(addrTy); + mlir::Type classTy = fir::ClassType::get(addrTy); + if (classTy == baseTy) { + addAssocEntitySymbol(selector); + } else { + mlir::Value derived = builder->create( + loc, classTy, fir::getBase(selector)); + addAssocEntitySymbol(selectorBox->clone(derived)); + } } builder->restoreInsertionPoint(crtInsPt); ++typeGuardIdx; diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp index 79313b9..b2b094a 100644 --- a/flang/lib/Optimizer/Dialect/FIROps.cpp +++ b/flang/lib/Optimizer/Dialect/FIROps.cpp @@ -937,7 +937,8 @@ mlir::LogicalResult fir::ConvertOp::verify() { (inType.isa() && outType.isa()) || (fir::isa_complex(inType) && fir::isa_complex(outType)) || (fir::isBoxedRecordType(inType) && fir::isPolymorphicType(outType)) || - (fir::isPolymorphicType(inType) && fir::isPolymorphicType(outType))) + (fir::isPolymorphicType(inType) && fir::isPolymorphicType(outType)) || + (fir::isPolymorphicType(inType) && outType.isa())) return mlir::success(); return emitOpError("invalid type conversion"); } diff --git a/flang/test/Lower/select-type.f90 b/flang/test/Lower/select-type.f90 index 744e7d9..957b656 100644 --- a/flang/test/Lower/select-type.f90 +++ b/flang/test/Lower/select-type.f90 @@ -427,16 +427,321 @@ contains ! CFG: ^[[EXIT_SELECT_BLK]]: ! CFG: return + subroutine select_type8(a) + class(*) :: a(:) + + select type(a) + type is (integer) + a = 100 + type is (real) + a = 2.0 + type is (character(*)) + a(1) = 'c' + a(2) = 'h' + type is (p1) + a%a = 1 + a%b = 2 + class is(p2) + a%a = 1 + a%b = 2 + a%c = 3 + class default + stop 'error' + end select + end subroutine + +! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type8( +! CHECK-SAME: %[[ARG0:.*]]: !fir.class> {fir.bindc_name = "a"}) { +! CHECK: %[[SELECTOR:.*]] = fir.rebox %[[ARG0]] : (!fir.class>) -> !fir.class> +! CHECK: fir.select_type %[[SELECTOR]] : !fir.class> [#fir.type_is, ^{{.*}}, #fir.type_is, ^{{.*}}, #fir.type_is>, ^bb{{.*}}, unit, ^{{.*}}] +! CHECK: ^bb{{.*}}: +! CHECK: %[[BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class>) -> !fir.box> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[SELECTOR_DIMS:.*]]:3 = fir.box_dims %[[BOX]], %[[C0]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[BOX]] : (!fir.box>) -> !fir.array +! CHECK: %[[C100:.*]] = arith.constant 100 : i32 +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[UB:.*]] = arith.subi %[[SELECTOR_DIMS:.*]]#1, %[[C1]] : index +! CHECK: %[[LOOP_RES:.*]] = fir.do_loop %[[IND:.*]] = %[[C0:.*]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array) { +! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %[[C100]], %[[IND]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[ARR_UP]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[LOOP_RES]] to %[[BOX]] : !fir.array, !fir.array, !fir.box> +! CHECK: cf.br ^{{.*}} +! CHECK: ^bb{{.*}}: +! CHECK: %[[BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class>) -> !fir.box> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[SELECTOR_DIMS:.*]]:3 = fir.box_dims %[[BOX]], %[[C0]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[BOX]] : (!fir.box>) -> !fir.array +! CHECK: %[[VALUE:.*]] = arith.constant 2.000000e+00 : f32 +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[UB:.*]] = arith.subi %[[SELECTOR_DIMS]]#1, %[[C1]] : index +! CHECK: %[[LOOP_RES:.*]] = fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array) { +! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %[[VALUE]], %[[IND]] : (!fir.array, f32, index) -> !fir.array +! CHECK: fir.result %[[ARR_UP]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[LOOP_RES]] to %[[BOX]] : !fir.array, !fir.array, !fir.box> +! CHECK: cf.br ^{{.*}} +! CHECK: ^bb{{.*}}: +! CHECK: %[[BOX:.*]] = fir.convert %0 : (!fir.class>) -> !fir.box>> +! CHECK: cf.br ^bb{{.*}} +! CHECK: ^bb{{.*}}: +! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class>) -> !fir.box>> +! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_A]] : (index, index, index, !fir.field) -> !fir.slice<1> +! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box>>, !fir.slice<1>) -> !fir.array +! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array) { +! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[ARR_UP]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array, !fir.array, !fir.box>>, !fir.slice<1> +! CHECK: %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_B]] : (index, index, index, !fir.field) -> !fir.slice<1> +! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box>>, !fir.slice<1>) -> !fir.array +! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %c{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array) { +! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[ARR_UP]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array, !fir.array, !fir.box>>, !fir.slice<1> +! CHECK: cf.br ^{{.*}} +! CHECK: ^bb{{.*}}: +! CHECK: %[[CLASS_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class>) -> !fir.class>> +! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[CLASS_BOX]], %[[C0]] : (!fir.class>>, index) -> (index, index, index) +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_A]] : (index, index, index, !fir.field) -> !fir.slice<1> +! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[CLASS_BOX]] [%[[SLICE]]] : (!fir.class>>, !fir.slice<1>) -> !fir.array +! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array) { +! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[ARR_UP]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[CLASS_BOX]][%[[SLICE]]] : !fir.array, !fir.array, !fir.class>>, !fir.slice<1> +! CHECK: %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[CLASS_BOX]], %[[C0]] : (!fir.class>>, index) -> (index, index, index) +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_B]] : (index, index, index, !fir.field) -> !fir.slice<1> +! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[CLASS_BOX]] [%[[SLICE]]] : (!fir.class>>, !fir.slice<1>) -> !fir.array +! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array) { +! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[ARR_UP]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[CLASS_BOX]][%[[SLICE]]] : !fir.array, !fir.array, !fir.class>>, !fir.slice<1> +! CHECK: %[[FIELD_C:.*]] = fir.field_index c, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[CLASS_BOX]], %[[C0]] : (!fir.class>>, index) -> (index, index, index) +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_C]] : (index, index, index, !fir.field) -> !fir.slice<1> +! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[CLASS_BOX]] [%[[SLICE]]] : (!fir.class>>, !fir.slice<1>) -> !fir.array +! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array) { +! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[ARR_UP]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[CLASS_BOX]][%[[SLICE]]] : !fir.array, !fir.array, !fir.class>>, !fir.slice<1> +! CHECK: cf.br ^bb{{.*}} + + subroutine select_type9(a) + class(p1) :: a(:) + + select type(a) + type is (p1) + a%a = 1 + a%b = 2 + type is(p2) + a%a = 1 + a%b = 2 + a%c = 3 + class default + stop 'error' + end select + end subroutine + +! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type9( +! CHECK-SAME: %[[ARG0:.*]]: !fir.class>> {fir.bindc_name = "a"}) { +! CHECK: %[[SELECTOR:.*]] = fir.rebox %[[ARG0]] : (!fir.class>>) -> !fir.class>> +! CHECK: fir.select_type %[[SELECTOR]] : !fir.class>> [#fir.type_is>, ^bb{{.*}}, #fir.type_is>, ^bb{{.*}}, unit, ^bb{{.*}}] +! CHECK: ^bb{{.*}}: +! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class>>) -> !fir.box>> +! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_A]] : (index, index, index, !fir.field) -> !fir.slice<1> +! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box>>, !fir.slice<1>) -> !fir.array +! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array) { +! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[ARR_UP]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array, !fir.array, !fir.box>>, !fir.slice<1> +! CHECK: %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_B]] : (index, index, index, !fir.field) -> !fir.slice<1> +! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box>>, !fir.slice<1>) -> !fir.array +! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %c{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array) { +! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[ARR_UP]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array, !fir.array, !fir.box>>, !fir.slice<1> +! CHECK: cf.br ^bb{{.*}} +! CHECK: ^bb{{.*}}: +! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class>>) -> !fir.box>> +! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_A]] : (index, index, index, !fir.field) -> !fir.slice<1> +! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box>>, !fir.slice<1>) -> !fir.array +! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array) { +! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[ARR_UP]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array, !fir.array, !fir.box>>, !fir.slice<1> +! CHECK: %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_B]] : (index, index, index, !fir.field) -> !fir.slice<1> +! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box>>, !fir.slice<1>) -> !fir.array +! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array) { +! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[ARR_UP]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array, !fir.array, !fir.box>>, !fir.slice<1> +! CHECK: %[[FIELD_C:.*]] = fir.field_index c, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_C]] : (index, index, index, !fir.field) -> !fir.slice<1> +! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box>>, !fir.slice<1>) -> !fir.array +! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array) { +! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[ARR_UP]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array, !fir.array, !fir.box>>, !fir.slice<1> +! CHECK: cf.br ^bb{{.*}} + + subroutine select_type10(a) + class(p1), pointer :: a + select type(a) + type is (p1) + a%a = 1 + type is (p2) + a%c = 3 + class is (p1) + a%a = 5 + end select + end subroutine + +! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type10( +! CHECK-SAME: %[[ARG0:.*]]: !fir.ref>>> {fir.bindc_name = "a"}) { +! CHECK: %[[SELECTOR:.*]] = fir.load %[[ARG0]] : !fir.ref>>> +! CHECK: fir.select_type %[[SELECTOR]] : !fir.class>> [#fir.type_is>, ^bb{{.*}}, #fir.type_is>, ^bb{{.*}}, #fir.class_is>, ^bb{{.*}}, unit, ^bb{{.*}}] +! CHECK: ^bb{{.*}}: +! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class>>) -> !fir.box>> +! CHECK: %[[C1:.*]] = arith.constant 1 : i32 +! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}> +! CHECK: %[[COORD_A:.*]] = fir.coordinate_of %[[EXACT_BOX]], %[[FIELD_A]] : (!fir.box>>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[C1]] to %[[COORD_A]] : !fir.ref +! CHECK: cf.br ^bb{{.*}} +! CHECK: ^bb{{.*}}: +! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class>>) -> !fir.box>> +! CHECK: %[[C3:.*]] = arith.constant 3 : i32 +! CHECK: %[[FIELD_C:.*]] = fir.field_index c, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}> +! CHECK: %[[COORD_C:.*]] = fir.coordinate_of %[[EXACT_BOX]], %[[FIELD_C]] : (!fir.box>>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[C3]] to %[[COORD_C]] : !fir.ref +! CHECK: cf.br ^bb{{.*}} +! CHECK: ^bb{{.*}} +! CHECK: %[[C5:.*]] = arith.constant 5 : i32 +! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}> +! CHECK: %[[COORD_A:.*]] = fir.coordinate_of %[[SELECTOR]], %[[FIELD_A]] : (!fir.class>>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[C5]] to %[[COORD_A]] : !fir.ref +! CHECK: cf.br ^bb{{.*}} + + subroutine select_type11(a) + class(p1), allocatable :: a + select type(a) + type is (p1) + a%a = 1 + type is (p2) + a%a = 2 + a%c = 3 + end select + end subroutine + +! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type11( +! CHECK-SAME: %[[ARG0:.*]]: !fir.ref>>> {fir.bindc_name = "a"}) { +! CHECK: %[[SELECTOR:.*]] = fir.load %[[ARG0]] : !fir.ref>>> +! CHECK: fir.select_type %[[SELECTOR]] : !fir.class>> [#fir.type_is>, ^bb1, #fir.type_is>, ^bb2, unit, ^bb3] +! CHECK: ^bb{{.*}}: +! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class>>) -> !fir.box>> +! CHECK: %[[C1:.*]] = arith.constant 1 : i32 +! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}> +! CHECK: %[[COORD_A:.*]] = fir.coordinate_of %[[EXACT_BOX]], %[[FIELD_A]] : (!fir.box>>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[C1]] to %[[COORD_A]] : !fir.ref +! CHECK: cf.br ^bb{{.*}} +! CHECK: ^bb{{.*}}: +! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class>>) -> !fir.box>> +! CHECK: %[[C3:.*]] = arith.constant 3 : i32 +! CHECK: %[[FIELD_C:.*]] = fir.field_index c, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}> +! CHECK: %[[COORD_C:.*]] = fir.coordinate_of %[[EXACT_BOX]], %[[FIELD_C]] : (!fir.box>>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[C3]] to %[[COORD_C]] : !fir.ref +! CHECK: cf.br ^bb{{.*}} + + subroutine select_type12(a) + class(p1), pointer :: a(:) + select type(a) + type is (p1) + a%a = 120 + type is (p2) + a%c = 121 + class is (p1) + a%a = 122 + end select + end subroutine + +! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type12( +! CHECK-SAME: %[[ARG0:.*]]: !fir.ref>>>> {fir.bindc_name = "a"}) { +! CHECK: %[[LOAD:.*]] = fir.load %[[ARG0]] : !fir.ref>>>> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[LOAD]], %[[C0]] : (!fir.class>>>, index) -> (index, index, index) +! CHECK: %[[SHIFT:.*]] = fir.shift %[[BOX_DIMS]]#0 : (index) -> !fir.shift<1> +! CHECK: %[[SELECTOR:.*]] = fir.rebox %[[LOAD]](%[[SHIFT]]) : (!fir.class>>>, !fir.shift<1>) -> !fir.class>> +! CHECK: fir.select_type %[[SELECTOR]] : !fir.class>> [#fir.type_is>, ^bb1, #fir.type_is>, ^bb2, #fir.class_is>, ^bb3, unit, ^bb4] +! CHECK: ^bb{{.*}}: +! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class>>) -> !fir.box>> +! CHECK: ^bb{{.*}}: // pred: ^bb0 +! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class>>) -> !fir.box>> + end module program test_select_type use select_type_lower_test integer :: a + integer :: arr(2) real :: b + real :: barr(2) + character(1) :: carr(2) type(p4) :: t4 - type(p2) :: t2 - type(p1) :: t1 + type(p1), target :: t1 + type(p2), target :: t2 + type(p1), target :: t1arr(2) + type(p2) :: t2arr(2) + class(p1), pointer :: p + class(p1), allocatable :: p1alloc + class(p1), allocatable :: p2alloc + class(p1), pointer :: parr(:) call select_type7(t4) call select_type7(t2) @@ -452,4 +757,52 @@ program test_select_type call select_type6(b) print*, b + print*, '> select_type8 with type(p1), dimension(2)' + call select_type8(t1arr) + print*, t1arr(1) + print*, t1arr(2) + + print*, '> select_type8 with type(p2), dimension(2)' + call select_type8(t2arr) + print*, t2arr(1) + print*, t2arr(2) + + print*, '> select_type8 with integer, dimension(2)' + call select_type8(arr) + print*, arr(:) + + print*, '> select_type8 with real, dimension(2)' + call select_type8(barr) + print*, barr(:) + + print*, '> select_type8 with character(1), dimension(2)' + call select_type8(carr) + print*, carr(:) + + t1%a = 0 + p => t1 + print*, '> select_type10' + call select_type10(p) + print*, t1 + + t2%c = 0 + p => t2 + print*, '> select_type10' + call select_type10(p) + print*, t2 + + allocate(p1::p1alloc) + print*, '> select_type11' + call select_type11(p1alloc) + print*, p1alloc%a + + allocate(p2::p2alloc) + print*, '> select_type11' + call select_type11(p2alloc) + print*, p2alloc%a + + parr => t1arr + call select_type12(parr) + print*, t1arr(1) + print*, t1arr(2) end