[flang-commits] [flang] 9379ca0 - [flang] Fix associating entity when selector is an array, pointer or allocatable
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Thu Dec 15 03:02:46 PST 2022
Author: Valentin Clement
Date: 2022-12-15T12:02:38+01:00
New Revision: 9379ca0a257780961a7e77c1a56c70d00cd85909
URL: https://github.com/llvm/llvm-project/commit/9379ca0a257780961a7e77c1a56c70d00cd85909
DIFF: https://github.com/llvm/llvm-project/commit/9379ca0a257780961a7e77c1a56c70d00cd85909.diff
LOG: [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
Added:
Modified:
flang/include/flang/Optimizer/Dialect/FIROps.td
flang/lib/Lower/Bridge.cpp
flang/lib/Optimizer/Dialect/FIROps.cpp
flang/test/Lower/select-type.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td
index 1e29710e39d7a..088294cf264ae 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 d2f63535a718e..c58acf8fdff3e 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -2299,6 +2299,12 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
};
+ 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<fir::SequenceType>();
+ const fir::BoxValue *selectorBox = selector.getBoxOf<fir::BoxValue>();
if (std::holds_alternative<Fortran::parser::Default>(guard.u)) {
// CLASS DEFAULT
addAssocEntitySymbol(selector);
@@ -2308,15 +2314,31 @@ class FirConverter : public Fortran::lower::AbstractConverter {
fir::ExactTypeAttr attr =
typeGuardAttr.dyn_cast<fir::ExactTypeAttr>();
mlir::Value exactValue;
+ mlir::Type addrTy = attr.getType();
+ if (isArray) {
+ auto seqTy = fir::dyn_cast_ptrOrBoxEleTy(baseTy)
+ .dyn_cast<fir::SequenceType>();
+ 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<Fortran::parser::IntrinsicTypeSpec>(
typeSpec->u)) {
+ mlir::Type refTy = fir::ReferenceType::get(addrTy);
+ if (isPointer || isAllocatable)
+ refTy = addrTy;
exactValue = builder->create<fir::BoxAddrOp>(
- 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<fir::ConvertOp>(
+ 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<fir::CharacterType>();
mlir::Value charLen =
fir::factory::CharacterExprHelper(*builder, loc)
@@ -2328,16 +2350,31 @@ class FirConverter : public Fortran::lower::AbstractConverter {
} else if (std::holds_alternative<Fortran::parser::DerivedTypeSpec>(
typeSpec->u)) {
exactValue = builder->create<fir::ConvertOp>(
- 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<Fortran::parser::DerivedTypeSpec>(
guard.u)) {
// CLASS IS
fir::SubclassAttr attr = typeGuardAttr.dyn_cast<fir::SubclassAttr>();
- mlir::Value derived = builder->create<fir::ConvertOp>(
- 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<fir::SequenceType>();
+ 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<fir::ConvertOp>(
+ 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 79313b9f76448..b2b094a126a63 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<fir::BoxProcType>() && outType.isa<fir::BoxProcType>()) ||
(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<BoxType>()))
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 744e7d9b2f99e..957b65652ee26 100644
--- a/flang/test/Lower/select-type.f90
+++ b/flang/test/Lower/select-type.f90
@@ -427,16 +427,321 @@ subroutine select_type7(a)
! 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.array<?xnone>> {fir.bindc_name = "a"}) {
+! CHECK: %[[SELECTOR:.*]] = fir.rebox %[[ARG0]] : (!fir.class<!fir.array<?xnone>>) -> !fir.class<!fir.array<?xnone>>
+! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.array<?xnone>> [#fir.type_is<i32>, ^{{.*}}, #fir.type_is<f32>, ^{{.*}}, #fir.type_is<!fir.char<1,?>>, ^bb{{.*}}, unit, ^{{.*}}]
+! CHECK: ^bb{{.*}}:
+! CHECK: %[[BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?xnone>>) -> !fir.box<!fir.array<?xi32>>
+! CHECK: %[[C0:.*]] = arith.constant 0 : index
+! CHECK: %[[SELECTOR_DIMS:.*]]:3 = fir.box_dims %[[BOX]], %[[C0]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)
+! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[BOX]] : (!fir.box<!fir.array<?xi32>>) -> !fir.array<?xi32>
+! 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<?xi32>) {
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %[[C100]], %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[LOOP_RES]] to %[[BOX]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?xi32>>
+! CHECK: cf.br ^{{.*}}
+! CHECK: ^bb{{.*}}:
+! CHECK: %[[BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?xnone>>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: %[[C0:.*]] = arith.constant 0 : index
+! CHECK: %[[SELECTOR_DIMS:.*]]:3 = fir.box_dims %[[BOX]], %[[C0]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[BOX]] : (!fir.box<!fir.array<?xf32>>) -> !fir.array<?xf32>
+! 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<?xf32>) {
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %[[VALUE]], %[[IND]] : (!fir.array<?xf32>, f32, index) -> !fir.array<?xf32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xf32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[LOOP_RES]] to %[[BOX]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.box<!fir.array<?xf32>>
+! CHECK: cf.br ^{{.*}}
+! CHECK: ^bb{{.*}}:
+! CHECK: %[[BOX:.*]] = fir.convert %0 : (!fir.class<!fir.array<?xnone>>) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+! CHECK: cf.br ^bb{{.*}}
+! CHECK: ^bb{{.*}}:
+! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?xnone>>) -> !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>
+! 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<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{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_A]] : (index, index, index, !fir.field) -> !fir.slice<1>
+! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>
+! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !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<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{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_B]] : (index, index, index, !fir.field) -> !fir.slice<1>
+! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>
+! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %c{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>
+! CHECK: cf.br ^{{.*}}
+! CHECK: ^bb{{.*}}:
+! CHECK: %[[CLASS_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?xnone>>) -> !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>
+! 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<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, 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.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>
+! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[CLASS_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !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<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, 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.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>
+! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[CLASS_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !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<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, 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.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>
+! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[CLASS_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !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.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "a"}) {
+! CHECK: %[[SELECTOR:.*]] = fir.rebox %[[ARG0]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>
+! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb{{.*}}, #fir.type_is<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>, ^bb{{.*}}, unit, ^bb{{.*}}]
+! CHECK: ^bb{{.*}}:
+! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>
+! 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<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{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_A]] : (index, index, index, !fir.field) -> !fir.slice<1>
+! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>
+! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !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<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{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_B]] : (index, index, index, !fir.field) -> !fir.slice<1>
+! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>
+! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %c{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>
+! CHECK: cf.br ^bb{{.*}}
+! CHECK: ^bb{{.*}}:
+! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>
+! 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<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, 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.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>
+! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !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<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, 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.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>
+! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !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<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, 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.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>
+! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !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.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "a"}) {
+! CHECK: %[[SELECTOR:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>
+! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb{{.*}}, #fir.type_is<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>, ^bb{{.*}}, #fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb{{.*}}, unit, ^bb{{.*}}]
+! CHECK: ^bb{{.*}}:
+! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>
+! 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.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.field) -> !fir.ref<i32>
+! CHECK: fir.store %[[C1]] to %[[COORD_A]] : !fir.ref<i32>
+! CHECK: cf.br ^bb{{.*}}
+! CHECK: ^bb{{.*}}:
+! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.ptr<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>
+! 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.ptr<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.field) -> !fir.ref<i32>
+! CHECK: fir.store %[[C3]] to %[[COORD_C]] : !fir.ref<i32>
+! 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.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.field) -> !fir.ref<i32>
+! CHECK: fir.store %[[C5]] to %[[COORD_A]] : !fir.ref<i32>
+! 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.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "a"}) {
+! CHECK: %[[SELECTOR:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>
+! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb1, #fir.type_is<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>, ^bb2, unit, ^bb3]
+! CHECK: ^bb{{.*}}:
+! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>
+! 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.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.field) -> !fir.ref<i32>
+! CHECK: fir.store %[[C1]] to %[[COORD_A]] : !fir.ref<i32>
+! CHECK: cf.br ^bb{{.*}}
+! CHECK: ^bb{{.*}}:
+! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.heap<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>
+! 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.heap<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.field) -> !fir.ref<i32>
+! CHECK: fir.store %[[C3]] to %[[COORD_C]] : !fir.ref<i32>
+! 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.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>> {fir.bindc_name = "a"}) {
+! CHECK: %[[LOAD:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>>
+! CHECK: %[[C0:.*]] = arith.constant 0 : index
+! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[LOAD]], %[[C0]] : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>, index) -> (index, index, index)
+! CHECK: %[[SHIFT:.*]] = fir.shift %[[BOX_DIMS]]#0 : (index) -> !fir.shift<1>
+! CHECK: %[[SELECTOR:.*]] = fir.rebox %[[LOAD]](%[[SHIFT]]) : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>, !fir.shift<1>) -> !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>
+! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb1, #fir.type_is<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>, ^bb2, #fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb3, unit, ^bb4]
+! CHECK: ^bb{{.*}}:
+! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>
+! CHECK: ^bb{{.*}}: // pred: ^bb0
+! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>
+
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
More information about the flang-commits
mailing list