1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s 2 3module storage_size_test 4 type :: p1 5 integer :: a 6 end type 7 8 type, extends(p1) :: p2 9 integer :: b 10 end type 11 12 type :: p3 13 class(p1), pointer :: p(:) 14 end type 15 16contains 17 18 integer function unlimited_polymorphic_pointer(p) result(size) 19 class(*), pointer :: p 20 size = storage_size(p) 21 end function 22 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>) -> i64 29! CHECK: %[[C0:.*]] = arith.constant 0 : i64 30! CHECK: %[[IS_NULL_ADDR:.*]] = arith.cmpi eq, %[[P_ADDR_I64]], %[[C0]] : i64 31! 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>>) -> i32 36! CHECK: %[[C8:.*]] = arith.constant 8 : i32 37! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32 38! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32> 39! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32> 40! CHECK: return %[[RES]] : i32 41 42 integer function unlimited_polymorphic_allocatable(p) result(size) 43 class(*), allocatable :: p 44 size = storage_size(p) 45 end function 46 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>) -> i64 53! CHECK: %[[C0:.*]] = arith.constant 0 : i64 54! CHECK: %[[IS_NULL_ADDR:.*]] = arith.cmpi eq, %[[P_ADDR_I64]], %[[C0]] : i64 55! 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>>) -> i32 60! CHECK: %[[C8:.*]] = arith.constant 8 : i32 61! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32 62! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32> 63! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32> 64! CHECK: return %[[RES]] : i32 65 66 integer function polymorphic_pointer(p) result(size) 67 class(p1), pointer :: p 68 size = storage_size(p) 69 end function 70 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}>>>) -> i32 76! CHECK: %[[C8:.*]] = arith.constant 8 : i32 77! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32 78! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32> 79! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32> 80! CHECK: return %[[RES]] : i32 81 82 integer function polymorphic(p) result(size) 83 class(p1) :: p 84 size = storage_size(p) 85 end function 86 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}>>) -> i32 91! CHECK: %[[C8:.*]] = arith.constant 8 : i32 92! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32 93! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32> 94! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32> 95! CHECK: return %[[RES]] : i32 96 97 integer(8) function polymorphic_rank(p) result(size) 98 class(p1) :: p 99 size = storage_size(p, 8) 100 end function 101 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}>>) -> i64 106! CHECK: %[[C8:.*]] = arith.constant 8 : i64 107! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i64 108! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i64> 109! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i64> 110! CHECK: return %[[RES]] : i64 111 112 integer function polymorphic_value(t) result(size) 113 type(p3) :: t 114 size = storage_size(t%p(1)) 115 end function 116 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: %[[FIELD_P:.*]] = fir.field_index p, !fir.type<_QMstorage_size_testTp3{p:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMstorage_size_testTp1{a:i32}>>>>}> 121! CHECK: %[[COORD_P:.*]] = fir.coordinate_of %[[T]], %[[FIELD_P]] : (!fir.ref<!fir.type<_QMstorage_size_testTp3{p:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMstorage_size_testTp1{a:i32}>>>>}>>, !fir.field) -> !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMstorage_size_testTp1{a:i32}>>>>> 122! CHECK: %[[LOAD_COORD_P:.*]] = fir.load %[[COORD_P]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMstorage_size_testTp1{a:i32}>>>>> 123! CHECK: %[[C0:.*]] = arith.constant 0 : index 124! 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) 125! CHECK: %[[C1:.*]] = arith.constant 1 : i64 126! CHECK: %[[DIMI64:.*]] = fir.convert %[[BOX_DIMS]]#0 : (index) -> i64 127! CHECK: %[[IDX:.*]] = arith.subi %[[C1]], %[[DIMI64]] : i64 128! 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}>> 129! 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}>> 130! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[BOXED]] : (!fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i32 131! CHECK: %[[C8:.*]] = arith.constant 8 : i32 132! CHECK: %[[SIZE:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32 133! CHECK: fir.store %[[SIZE]] to %[[ALLOCA]] : !fir.ref<i32> 134! CHECK: %[[RET:.*]] = fir.load %[[ALLOCA]] : !fir.ref<i32> 135! CHECK: return %[[RET]] : i32 136 137end module 138