137 lines · plain
1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s2 3module storage_size_test4 type :: p15 integer :: a6 end type7 8 type, extends(p1) :: p29 integer :: b10 end type11 12 type :: p313 class(p1), pointer :: p(:)14 end type15 16contains17 18 integer function unlimited_polymorphic_pointer(p) result(size)19 class(*), pointer :: p20 size = storage_size(p)21 end function22 23! CHECK-LABEL: func.func @_QMstorage_size_testPunlimited_polymorphic_pointer(24! CHECK-SAME: %[[P:.*]]: !fir.ref<!fir.class<!fir.ptr<none>>> {fir.bindc_name = "p"}) -> i32 {25! CHECK: %[[SIZE:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFunlimited_polymorphic_pointerEsize"}26! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<none>>>27! CHECK: %[[P_ADDR:.*]] = fir.box_addr %[[LOAD_P]] : (!fir.class<!fir.ptr<none>>) -> !fir.ptr<none>28! CHECK: %[[P_ADDR_I64:.*]] = fir.convert %[[P_ADDR]] : (!fir.ptr<none>) -> i6429! CHECK: %[[C0:.*]] = arith.constant 0 : i6430! CHECK: %[[IS_NULL_ADDR:.*]] = arith.cmpi eq, %[[P_ADDR_I64]], %[[C0]] : i6431! CHECK: fir.if %[[IS_NULL_ADDR]] {32! CHECK: fir.call @_FortranAReportFatalUserError(%{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<i8>, !fir.ref<i8>, i32) -> ()33! CHECK: }34! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<none>>>35! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[LOAD_P]] : (!fir.class<!fir.ptr<none>>) -> i3236! CHECK: %[[C8:.*]] = arith.constant 8 : i3237! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i3238! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>39! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>40! CHECK: return %[[RES]] : i3241 42 integer function unlimited_polymorphic_allocatable(p) result(size)43 class(*), allocatable :: p44 size = storage_size(p)45 end function46 47! CHECK-LABEL: func.func @_QMstorage_size_testPunlimited_polymorphic_allocatable(48! CHECK-SAME: %[[P:.*]]: !fir.ref<!fir.class<!fir.heap<none>>> {fir.bindc_name = "p"}) -> i32 {49! CHECK: %[[SIZE:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFunlimited_polymorphic_allocatableEsize"}50! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.heap<none>>>51! CHECK: %[[P_ADDR:.*]] = fir.box_addr %[[LOAD_P]] : (!fir.class<!fir.heap<none>>) -> !fir.heap<none>52! CHECK: %[[P_ADDR_I64:.*]] = fir.convert %[[P_ADDR]] : (!fir.heap<none>) -> i6453! CHECK: %[[C0:.*]] = arith.constant 0 : i6454! CHECK: %[[IS_NULL_ADDR:.*]] = arith.cmpi eq, %[[P_ADDR_I64]], %[[C0]] : i6455! CHECK: fir.if %[[IS_NULL_ADDR]] {56! CHECK: fir.call @_FortranAReportFatalUserError(%{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<i8>, !fir.ref<i8>, i32) -> ()57! CHECK: }58! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.heap<none>>>59! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[LOAD_P]] : (!fir.class<!fir.heap<none>>) -> i3260! CHECK: %[[C8:.*]] = arith.constant 8 : i3261! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i3262! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>63! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>64! CHECK: return %[[RES]] : i3265 66 integer function polymorphic_pointer(p) result(size)67 class(p1), pointer :: p68 size = storage_size(p)69 end function70 71! CHECK-LABEL: func.func @_QMstorage_size_testPpolymorphic_pointer(72! CHECK-SAME: %[[P:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>> {fir.bindc_name = "p"}) -> i32 {73! CHECK: %[[SIZE:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFpolymorphic_pointerEsize"}74! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>>75! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[LOAD_P]] : (!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>) -> i3276! CHECK: %[[C8:.*]] = arith.constant 8 : i3277! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i3278! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>79! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>80! CHECK: return %[[RES]] : i3281 82 integer function polymorphic(p) result(size)83 class(p1) :: p84 size = storage_size(p)85 end function86 87! CHECK-LABEL: func.func @_QMstorage_size_testPpolymorphic(88! CHECK-SAME: %[[P:.*]]: !fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>> {fir.bindc_name = "p"}) -> i32 {89! CHECK: %[[SIZE:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFpolymorphicEsize"}90! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[P]] : (!fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i3291! CHECK: %[[C8:.*]] = arith.constant 8 : i3292! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i3293! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>94! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>95! CHECK: return %[[RES]] : i3296 97 integer(8) function polymorphic_rank(p) result(size)98 class(p1) :: p99 size = storage_size(p, 8)100 end function101 102! CHECK-LABEL: func.func @_QMstorage_size_testPpolymorphic_rank(103! CHECK-SAME: %[[P:.*]]: !fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>> {fir.bindc_name = "p"}) -> i64 {104! CHECK: %[[SIZE:.*]] = fir.alloca i64 {bindc_name = "size", uniq_name = "_QMstorage_size_testFpolymorphic_rankEsize"}105! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[P]] : (!fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i64106! CHECK: %[[C8:.*]] = arith.constant 8 : i64107! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i64108! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i64>109! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i64>110! CHECK: return %[[RES]] : i64111 112 integer function polymorphic_value(t) result(size)113 type(p3) :: t114 size = storage_size(t%p(1))115 end function116 117! CHECK-LABEL: func.func @_QMstorage_size_testPpolymorphic_value(118! CHECK-SAME: %[[T:.*]]: !fir.ref<!fir.type<_QMstorage_size_testTp3{p:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMstorage_size_testTp1{a:i32}>>>>}>> {fir.bindc_name = "t"}) -> i32 {119! CHECK: %[[ALLOCA:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFpolymorphic_valueEsize"}120! CHECK: %[[COORD_P:.*]] = fir.coordinate_of %[[T]], p : (!fir.ref<!fir.type<_QMstorage_size_testTp3{p:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMstorage_size_testTp1{a:i32}>>>>}>>) -> !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMstorage_size_testTp1{a:i32}>>>>>121! CHECK: %[[LOAD_COORD_P:.*]] = fir.load %[[COORD_P]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMstorage_size_testTp1{a:i32}>>>>>122! CHECK: %[[C0:.*]] = arith.constant 0 : index123! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[LOAD_COORD_P]], %[[C0]] : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMstorage_size_testTp1{a:i32}>>>>, index) -> (index, index, index)124! CHECK: %[[C1:.*]] = arith.constant 1 : i64125! CHECK: %[[DIMI64:.*]] = fir.convert %[[BOX_DIMS]]#0 : (index) -> i64126! CHECK: %[[IDX:.*]] = arith.subi %[[C1]], %[[DIMI64]] : i64127! CHECK: %[[COORD_OF:.*]] = fir.coordinate_of %[[LOAD_COORD_P]], %[[IDX]] : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMstorage_size_testTp1{a:i32}>>>>, i64) -> !fir.ref<!fir.type<_QMstorage_size_testTp1{a:i32}>>128! CHECK: %[[BOXED:.*]] = fir.embox %[[COORD_OF]] source_box %[[LOAD_COORD_P]] : (!fir.ref<!fir.type<_QMstorage_size_testTp1{a:i32}>>, !fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMstorage_size_testTp1{a:i32}>>>>) -> !fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>>129! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[BOXED]] : (!fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i32130! CHECK: %[[C8:.*]] = arith.constant 8 : i32131! CHECK: %[[SIZE:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32132! CHECK: fir.store %[[SIZE]] to %[[ALLOCA]] : !fir.ref<i32>133! CHECK: %[[RET:.*]] = fir.load %[[ALLOCA]] : !fir.ref<i32>134! CHECK: return %[[RET]] : i32135 136end module137