162 lines · plain
1! Test lowering of user calls involving passing an actual argument2! that is syntactically present, but may be absent at runtime (is3! an optional or a pointer/allocatable).4!5! RUN: bbc -emit-hlfir -o - %s | FileCheck %s6 7subroutine optional_copy_in_out(x)8 interface9 subroutine takes_optional_explicit(x)10 real, optional :: x(*)11 end subroutine12 end interface13 real, optional :: x(:)14 call takes_optional_explicit(x)15end subroutine16! CHECK-LABEL: func.func @_QPoptional_copy_in_out(17! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFoptional_copy_in_outEx"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)18! CHECK: %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xf32>>) -> i119! CHECK: %[[VAL_3:.*]]:3 = fir.if %[[VAL_2]] -> (!fir.ref<!fir.array<?xf32>>, i1, !fir.box<!fir.array<?xf32>>) {20! CHECK: %[[VAL_4:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 to %[[TMP_BOX:.*]] : (!fir.box<!fir.array<?xf32>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> (!fir.box<!fir.array<?xf32>>, i1)21! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]]#0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>22! CHECK: fir.result %[[VAL_5]], %[[VAL_4]]#1, %[[VAL_1]]#0 : !fir.ref<!fir.array<?xf32>>, i1, !fir.box<!fir.array<?xf32>>23! CHECK: } else {24! CHECK: %[[VAL_7:.*]] = fir.absent !fir.ref<!fir.array<?xf32>>25! CHECK: %[[VAL_8:.*]] = arith.constant false26! CHECK: %[[VAL_9:.*]] = fir.absent !fir.box<!fir.array<?xf32>>27! CHECK: fir.result %[[VAL_7]], %[[VAL_8]], %[[VAL_9]] : !fir.ref<!fir.array<?xf32>>, i1, !fir.box<!fir.array<?xf32>>28! CHECK: }29! CHECK: fir.call @_QPtakes_optional_explicit(%[[VAL_3]]#0) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> ()30! CHECK: hlfir.copy_out %[[TMP_BOX]], %[[VAL_3]]#1 to %[[VAL_3]]#2 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>, i1, !fir.box<!fir.array<?xf32>>) -> ()31 32subroutine optional_value_copy(x)33 interface34 subroutine takes_optional_explicit_value(x)35 real, value, optional :: x(100)36 end subroutine37 end interface38 real, optional :: x(100)39 call takes_optional_explicit_value(x)40end subroutine41! CHECK-LABEL: func.func @_QPoptional_value_copy(42! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_2:[a-z0-9]*]]) dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFoptional_value_copyEx"} : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>, !fir.dscope) -> (!fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>)43! CHECK: %[[VAL_4:.*]] = fir.is_present %[[VAL_3]]#0 : (!fir.ref<!fir.array<100xf32>>) -> i144! CHECK: %[[VAL_5:.*]]:3 = fir.if %[[VAL_4]] -> (!fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>, i1) {45! CHECK: %[[VAL_6:.*]] = hlfir.as_expr %[[VAL_3]]#0 : (!fir.ref<!fir.array<100xf32>>) -> !hlfir.expr<100xf32>46! CHECK: %[[VAL_7:.*]]:3 = hlfir.associate %[[VAL_6]](%[[VAL_2]]) {adapt.valuebyref} : (!hlfir.expr<100xf32>, !fir.shape<1>) -> (!fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>, i1)47! CHECK: fir.result %[[VAL_7]]#0, %[[VAL_7]]#1, %[[VAL_7]]#2 : !fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>, i148! CHECK: } else {49! CHECK: %[[VAL_8:.*]] = fir.absent !fir.ref<!fir.array<100xf32>>50! CHECK: %[[VAL_9:.*]] = fir.absent !fir.ref<!fir.array<100xf32>>51! CHECK: %[[VAL_10:.*]] = arith.constant false52! CHECK: fir.result %[[VAL_8]], %[[VAL_9]], %[[VAL_10]] : !fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>, i153! CHECK: }54! CHECK: fir.call @_QPtakes_optional_explicit_value(%[[VAL_5]]#0) {{.*}} : (!fir.ref<!fir.array<100xf32>>) -> ()55! CHECK: hlfir.end_associate %[[VAL_5]]#1, %[[VAL_5]]#2 : !fir.ref<!fir.array<100xf32>>, i156 57subroutine elem_pointer_to_optional(x, y)58 interface59 elemental subroutine elem_takes_two_optional(x, y)60 real, optional, intent(in) :: y, x61 end subroutine62 end interface63 real :: x(:)64 real, pointer :: y(:)65 call elem_takes_two_optional(x, y)66end subroutine67! CHECK-LABEL: func.func @_QPelem_pointer_to_optional(68! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {uniq_name = "_QFelem_pointer_to_optionalEx"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)69! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFelem_pointer_to_optionalEy"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.dscope) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>)70! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>71! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>72! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.ptr<!fir.array<?xf32>>) -> i6473! CHECK: %[[VAL_7:.*]] = arith.constant 0 : i6474! CHECK: %[[VAL_8:.*]] = arith.cmpi ne, %[[VAL_6]], %[[VAL_7]] : i6475! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index76! CHECK: %[[VAL_10:.*]]:3 = fir.box_dims %[[VAL_2]]#0, %[[VAL_9]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)77! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>78! CHECK: %[[VAL_12:.*]] = arith.constant 1 : index79! CHECK: fir.do_loop %[[VAL_13:.*]] = %[[VAL_12]] to %[[VAL_10]]#1 step %[[VAL_12]] unordered {80! CHECK: %[[VAL_14:.*]] = hlfir.designate %[[VAL_2]]#0 (%[[VAL_13]]) : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>81! CHECK: %[[VAL_15:.*]] = fir.if %[[VAL_8]] -> (!fir.ref<f32>) {82! CHECK: %[[VAL_16:.*]] = arith.constant 0 : index83! CHECK: %[[VAL_17:.*]]:3 = fir.box_dims %[[VAL_11]], %[[VAL_16]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)84! CHECK: %[[VAL_18:.*]] = arith.constant 1 : index85! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_17]]#0, %[[VAL_18]] : index86! CHECK: %[[VAL_20:.*]] = arith.addi %[[VAL_13]], %[[VAL_19]] : index87! CHECK: %[[VAL_21:.*]] = hlfir.designate %[[VAL_11]] (%[[VAL_20]]) : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> !fir.ref<f32>88! CHECK: fir.result %[[VAL_21]] : !fir.ref<f32>89! CHECK: } else {90! CHECK: %[[VAL_22:.*]] = fir.absent !fir.ref<f32>91! CHECK: fir.result %[[VAL_22]] : !fir.ref<f32>92! CHECK: }93! CHECK: fir.call @_QPelem_takes_two_optional(%[[VAL_14]], %[[VAL_15]]) {{.*}} : (!fir.ref<f32>, !fir.ref<f32>) -> ()94! CHECK: }95 96subroutine optional_cannot_be_absent_optional(x)97 interface98 elemental subroutine elem_takes_one_optional(x)99 real, optional, intent(in) :: x100 end subroutine101 end interface102 real, optional :: x(:)103 ! If all array arguments in an call are optional, they must be all present.104 call elem_takes_one_optional(x)105end subroutine106! CHECK-LABEL: func.func @_QPoptional_cannot_be_absent_optional(107! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFoptional_cannot_be_absent_optionalEx"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)108! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index109! CHECK: %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_1]]#0, %[[VAL_2]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)110! CHECK: %[[VAL_4:.*]] = arith.constant 1 : index111! CHECK: fir.do_loop %[[VAL_5:.*]] = %[[VAL_4]] to %[[VAL_3]]#1 step %[[VAL_4]] unordered {112! CHECK: %[[VAL_6:.*]] = hlfir.designate %[[VAL_1]]#0 (%[[VAL_5]]) : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>113! CHECK: fir.call @_QPelem_takes_one_optional(%[[VAL_6]]) {{.*}} : (!fir.ref<f32>) -> ()114! CHECK: }115 116subroutine optional_elem_poly(x, y)117 interface118 elemental subroutine elem_optional_poly(x, y)119 class(*), optional, intent(in) :: x, y120 end subroutine121 end interface122 real :: x(:)123 real, optional :: y(:)124 call elem_optional_poly(x, y)125end subroutine126! CHECK-LABEL: func.func @_QPoptional_elem_poly(127! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {uniq_name = "_QFoptional_elem_polyEx"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)128! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFoptional_elem_polyEy"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)129! CHECK: %[[VAL_4:.*]] = fir.is_present %[[VAL_3]]#0 : (!fir.box<!fir.array<?xf32>>) -> i1130! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index131! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_2]]#0, %[[VAL_5]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)132! CHECK: %[[VAL_7:.*]] = arith.constant 1 : index133! CHECK: fir.do_loop %[[VAL_8:.*]] = %[[VAL_7]] to %[[VAL_6]]#1 step %[[VAL_7]] unordered {134! CHECK: %[[VAL_9:.*]] = hlfir.designate %[[VAL_2]]#0 (%[[VAL_8]]) : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>135! CHECK: %[[VAL_10:.*]] = fir.embox %[[VAL_9]] : (!fir.ref<f32>) -> !fir.box<f32>136! CHECK: %[[VAL_11:.*]] = fir.rebox %[[VAL_10]] : (!fir.box<f32>) -> !fir.class<none>137! CHECK: %[[VAL_12:.*]] = fir.if %[[VAL_4]] -> (!fir.class<none>) {138! CHECK: %[[VAL_13:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_8]]) : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>139! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_13]] : (!fir.ref<f32>) -> !fir.box<f32>140! CHECK: %[[VAL_15:.*]] = fir.rebox %[[VAL_14]] : (!fir.box<f32>) -> !fir.class<none>141! CHECK: fir.result %[[VAL_15]] : !fir.class<none>142! CHECK: } else {143! CHECK: %[[VAL_16:.*]] = fir.absent !fir.class<none>144! CHECK: fir.result %[[VAL_16]] : !fir.class<none>145! CHECK: }146! CHECK: fir.call @_QPelem_optional_poly(%[[VAL_11]], %[[VAL_12]]) {{.*}} : (!fir.class<none>, !fir.class<none>) -> ()147! CHECK: }148 149subroutine test_passing_null()150 interface151 subroutine takes_optional_assumed(x)152 real, optional :: x(:)153 end subroutine154 end interface155 call takes_optional_assumed(null())156 ! NULL(MOLD) lowering is a TODO in HLFIR.157 ! call takes_optional_assumed(null(p))158end subroutine159! CHECK-LABEL: func.func @_QPtest_passing_null() {160! CHECK: %[[VAL_0:.*]] = fir.absent !fir.box<!fir.array<?xf32>>161! CHECK: fir.call @_QPtakes_optional_assumed(%[[VAL_0]]) {{.*}} : (!fir.box<!fir.array<?xf32>>) -> ()162