flang/test/Lower/Intrinsics/storage_size.f90

   1 ! RUN: bbc -emit-fir -polymorphic-type %s -o - | FileCheck %s
   2
   3 module 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
  16 contains
  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) -> none
  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) -> none
  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: %[[P_ADDR:.*]] = fir.box_addr %[[LOAD_P]] : (!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>) -> !fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>
  76 ! CHECK: %[[P_ADDR_I64:.*]] = fir.convert %[[P_ADDR]] : (!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i64
  77 ! CHECK: %[[C0:.*]] = arith.constant 0 : i64
  78 ! CHECK: %[[IS_NULL_ADDR:.*]] = arith.cmpi eq, %[[P_ADDR_I64]], %[[C0]] : i64
  79 ! CHECK: fir.if %[[IS_NULL_ADDR]] {
  80 ! CHECK:   %{{.*}} = fir.call @_FortranAReportFatalUserError(%{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<i8>, !fir.ref<i8>, i32) -> none
  81 ! CHECK: }
  82 ! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>>
  83 ! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[LOAD_P]] : (!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>) -> i32
  84 ! CHECK: %[[C8:.*]] = arith.constant 8 : i32
  85 ! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32
  86 ! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>
  87 ! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>
  88 ! CHECK: return %[[RES]] : i32
  89
  90   integer function polymorphic(p) result(size)
  91     class(p1) :: p
  92     size = storage_size(p)
  93   end function
  94
  95 ! CHECK-LABEL: func.func @_QMstorage_size_testPpolymorphic(
  96 ! CHECK-SAME: %[[P:.*]]: !fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>> {fir.bindc_name = "p"}) -> i32 {
  97 ! CHECK: %[[SIZE:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFpolymorphicEsize"}
  98 ! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[P]] : (!fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i32
  99 ! CHECK: %[[C8:.*]] = arith.constant 8 : i32
 100 ! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32
 101 ! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>
 102 ! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>
 103 ! CHECK: return %[[RES]] : i32
 104
 105   integer(8) function polymorphic_rank(p) result(size)
 106     class(p1) :: p
 107     size = storage_size(p, 8)
 108   end function
 109
 110 ! CHECK-LABEL: func.func @_QMstorage_size_testPpolymorphic_rank(
 111 ! CHECK-SAME: %[[P:.*]]: !fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>> {fir.bindc_name = "p"}) -> i64 {
 112 ! CHECK: %[[SIZE:.*]] = fir.alloca i64 {bindc_name = "size", uniq_name = "_QMstorage_size_testFpolymorphic_rankEsize"}
 113 ! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[P]] : (!fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i64
 114 ! CHECK: %[[C8:.*]] = arith.constant 8 : i64
 115 ! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i64
 116 ! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i64>
 117 ! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i64>
 118 ! CHECK: return %[[RES]] : i64
 119
 120   integer function polymorphic_value(t) result(size)
 121     type(p3) :: t
 122     size = storage_size(t%p(1))
 123   end function
 124
 125 ! CHECK-LABEL: func.func @_QMstorage_size_testPpolymorphic_value(
 126 ! 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 {
 127 ! CHECK: %[[ALLOCA:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFpolymorphic_valueEsize"}
 128 ! 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}>>>>}>
 129 ! 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}>>>>>
 130 ! CHECK: %[[LOAD_COORD_P:.*]] = fir.load %[[COORD_P]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMstorage_size_testTp1{a:i32}>>>>>
 131 ! CHECK: %[[C0:.*]] = arith.constant 0 : index
 132 ! 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)
 133 ! CHECK: %[[C1:.*]] = arith.constant 1 : i64
 134 ! CHECK: %[[DIMI64:.*]] = fir.convert %[[BOX_DIMS]]#0 : (index) -> i64
 135 ! CHECK: %[[IDX:.*]] = arith.subi %[[C1]], %[[DIMI64]] : i64
 136 ! 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}>>
 137 ! 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}>>
 138 ! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[BOXED]] : (!fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i32
 139 ! CHECK: %[[C8:.*]] = arith.constant 8 : i32
 140 ! CHECK: %[[SIZE:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32
 141 ! CHECK: fir.store %[[SIZE]] to %[[ALLOCA]] : !fir.ref<i32>
 142 ! CHECK: %[[RET:.*]] = fir.load %[[ALLOCA]] : !fir.ref<i32>
 143 ! CHECK: return %[[RET]] : i32
 144
 145 end module