! Test lowering of user calls involving passing an actual argument ! that is syntactically present, but may be absent at runtime (is ! an optional or a pointer/allocatable). ! ! RUN: bbc -emit-hlfir -polymorphic-type -o - %s | FileCheck %s subroutine optional_copy_in_out(x) interface subroutine takes_optional_explicit(x) real, optional :: x(*) end subroutine end interface real, optional :: x(:) call takes_optional_explicit(x) end subroutine ! CHECK-LABEL: func.func @_QPoptional_copy_in_out( ! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFoptional_copy_in_outEx"} : (!fir.box>) -> (!fir.box>, !fir.box>) ! CHECK: %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box>) -> i1 ! CHECK: %[[VAL_3:.*]]:4 = fir.if %[[VAL_2]] -> (!fir.ref>, !fir.box>, i1, !fir.box>) { ! CHECK: %[[VAL_4:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 : (!fir.box>) -> (!fir.box>, i1) ! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]]#0 : (!fir.box>) -> !fir.ref> ! CHECK: fir.result %[[VAL_5]], %[[VAL_4]]#0, %[[VAL_4]]#1, %[[VAL_1]]#0 : !fir.ref>, !fir.box>, i1, !fir.box> ! CHECK: } else { ! CHECK: %[[VAL_6:.*]] = fir.absent !fir.ref> ! CHECK: %[[VAL_7:.*]] = fir.absent !fir.box> ! CHECK: %[[VAL_8:.*]] = arith.constant false ! CHECK: %[[VAL_9:.*]] = fir.absent !fir.box> ! CHECK: fir.result %[[VAL_6]], %[[VAL_7]], %[[VAL_8]], %[[VAL_9]] : !fir.ref>, !fir.box>, i1, !fir.box> ! CHECK: } ! CHECK: fir.call @_QPtakes_optional_explicit(%[[VAL_3]]#0) {{.*}} : (!fir.ref>) -> () ! CHECK: hlfir.copy_out %[[VAL_3]]#1, %[[VAL_3]]#2 to %[[VAL_3]]#3 : (!fir.box>, i1, !fir.box>) -> () subroutine optional_value_copy(x) interface subroutine takes_optional_explicit_value(x) real, value, optional :: x(100) end subroutine end interface real, optional :: x(100) call takes_optional_explicit_value(x) end subroutine ! CHECK-LABEL: func.func @_QPoptional_value_copy( ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_2:[a-z0-9]*]]) {fortran_attrs = #fir.var_attrs, uniq_name = "_QFoptional_value_copyEx"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) ! CHECK: %[[VAL_4:.*]] = fir.is_present %[[VAL_3]]#0 : (!fir.ref>) -> i1 ! CHECK: %[[VAL_5:.*]]:3 = fir.if %[[VAL_4]] -> (!fir.ref>, !fir.ref>, i1) { ! CHECK: %[[VAL_6:.*]] = hlfir.as_expr %[[VAL_3]]#0 : (!fir.ref>) -> !hlfir.expr<100xf32> ! CHECK: %[[VAL_7:.*]]:3 = hlfir.associate %[[VAL_6]](%[[VAL_2]]) {adapt.valuebyref} : (!hlfir.expr<100xf32>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>, i1) ! CHECK: fir.result %[[VAL_7]]#1, %[[VAL_7]]#1, %[[VAL_7]]#2 : !fir.ref>, !fir.ref>, i1 ! CHECK: } else { ! CHECK: %[[VAL_8:.*]] = fir.absent !fir.ref> ! CHECK: %[[VAL_9:.*]] = fir.absent !fir.ref> ! CHECK: %[[VAL_10:.*]] = arith.constant false ! CHECK: fir.result %[[VAL_8]], %[[VAL_9]], %[[VAL_10]] : !fir.ref>, !fir.ref>, i1 ! CHECK: } ! CHECK: fir.call @_QPtakes_optional_explicit_value(%[[VAL_5]]#0) {{.*}} : (!fir.ref>) -> () ! CHECK: hlfir.end_associate %[[VAL_5]]#1, %[[VAL_5]]#2 : !fir.ref>, i1 subroutine elem_pointer_to_optional(x, y) interface elemental subroutine elem_takes_two_optional(x, y) real, optional, intent(in) :: y, x end subroutine end interface real :: x(:) real, pointer :: y(:) call elem_takes_two_optional(x, y) end subroutine ! CHECK-LABEL: func.func @_QPelem_pointer_to_optional( ! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {uniq_name = "_QFelem_pointer_to_optionalEx"} : (!fir.box>) -> (!fir.box>, !fir.box>) ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFelem_pointer_to_optionalEy"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) ! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref>>> ! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box>>) -> !fir.ptr> ! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.ptr>) -> i64 ! CHECK: %[[VAL_7:.*]] = arith.constant 0 : i64 ! CHECK: %[[VAL_8:.*]] = arith.cmpi ne, %[[VAL_6]], %[[VAL_7]] : i64 ! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index ! CHECK: %[[VAL_10:.*]]:3 = fir.box_dims %[[VAL_2]]#0, %[[VAL_9]] : (!fir.box>, index) -> (index, index, index) ! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref>>> ! CHECK: %[[VAL_12:.*]] = arith.constant 1 : index ! CHECK: fir.do_loop %[[VAL_13:.*]] = %[[VAL_12]] to %[[VAL_10]]#1 step %[[VAL_12]] unordered { ! CHECK: %[[VAL_14:.*]] = hlfir.designate %[[VAL_2]]#0 (%[[VAL_13]]) : (!fir.box>, index) -> !fir.ref ! CHECK: %[[VAL_15:.*]] = fir.if %[[VAL_8]] -> (!fir.ref) { ! CHECK: %[[VAL_16:.*]] = arith.constant 0 : index ! CHECK: %[[VAL_17:.*]]:3 = fir.box_dims %[[VAL_11]], %[[VAL_16]] : (!fir.box>>, index) -> (index, index, index) ! CHECK: %[[VAL_18:.*]] = arith.constant 1 : index ! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_17]]#0, %[[VAL_18]] : index ! CHECK: %[[VAL_20:.*]] = arith.addi %[[VAL_13]], %[[VAL_19]] : index ! CHECK: %[[VAL_21:.*]] = hlfir.designate %[[VAL_11]] (%[[VAL_20]]) : (!fir.box>>, index) -> !fir.ref ! CHECK: fir.result %[[VAL_21]] : !fir.ref ! CHECK: } else { ! CHECK: %[[VAL_22:.*]] = fir.absent !fir.ref ! CHECK: fir.result %[[VAL_22]] : !fir.ref ! CHECK: } ! CHECK: fir.call @_QPelem_takes_two_optional(%[[VAL_14]], %[[VAL_15]]) {{.*}} : (!fir.ref, !fir.ref) -> () ! CHECK: } subroutine optional_cannot_be_absent_optional(x) interface elemental subroutine elem_takes_one_optional(x) real, optional, intent(in) :: x end subroutine end interface real, optional :: x(:) ! If all array arguments in an call are optional, they must be all present. call elem_takes_one_optional(x) end subroutine ! CHECK-LABEL: func.func @_QPoptional_cannot_be_absent_optional( ! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFoptional_cannot_be_absent_optionalEx"} : (!fir.box>) -> (!fir.box>, !fir.box>) ! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index ! CHECK: %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_1]]#0, %[[VAL_2]] : (!fir.box>, index) -> (index, index, index) ! CHECK: %[[VAL_4:.*]] = arith.constant 1 : index ! CHECK: fir.do_loop %[[VAL_5:.*]] = %[[VAL_4]] to %[[VAL_3]]#1 step %[[VAL_4]] unordered { ! CHECK: %[[VAL_6:.*]] = hlfir.designate %[[VAL_1]]#0 (%[[VAL_5]]) : (!fir.box>, index) -> !fir.ref ! CHECK: fir.call @_QPelem_takes_one_optional(%[[VAL_6]]) {{.*}} : (!fir.ref) -> () ! CHECK: } subroutine optional_elem_poly(x, y) interface elemental subroutine elem_optional_poly(x, y) class(*), optional, intent(in) :: x, y end subroutine end interface real :: x(:) real, optional :: y(:) call elem_optional_poly(x, y) end subroutine ! CHECK-LABEL: func.func @_QPoptional_elem_poly( ! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {uniq_name = "_QFoptional_elem_polyEx"} : (!fir.box>) -> (!fir.box>, !fir.box>) ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFoptional_elem_polyEy"} : (!fir.box>) -> (!fir.box>, !fir.box>) ! CHECK: %[[VAL_4:.*]] = fir.is_present %[[VAL_3]]#0 : (!fir.box>) -> i1 ! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index ! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_2]]#0, %[[VAL_5]] : (!fir.box>, index) -> (index, index, index) ! CHECK: %[[VAL_7:.*]] = arith.constant 1 : index ! CHECK: fir.do_loop %[[VAL_8:.*]] = %[[VAL_7]] to %[[VAL_6]]#1 step %[[VAL_7]] unordered { ! CHECK: %[[VAL_9:.*]] = hlfir.designate %[[VAL_2]]#0 (%[[VAL_8]]) : (!fir.box>, index) -> !fir.ref ! CHECK: %[[VAL_10:.*]] = fir.embox %[[VAL_9]] : (!fir.ref) -> !fir.box ! CHECK: %[[VAL_11:.*]] = fir.rebox %[[VAL_10]] : (!fir.box) -> !fir.class ! CHECK: %[[VAL_12:.*]] = fir.if %[[VAL_4]] -> (!fir.class) { ! CHECK: %[[VAL_13:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_8]]) : (!fir.box>, index) -> !fir.ref ! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_13]] : (!fir.ref) -> !fir.box ! CHECK: %[[VAL_15:.*]] = fir.rebox %[[VAL_14]] : (!fir.box) -> !fir.class ! CHECK: fir.result %[[VAL_15]] : !fir.class ! CHECK: } else { ! CHECK: %[[VAL_16:.*]] = fir.absent !fir.class ! CHECK: fir.result %[[VAL_16]] : !fir.class ! CHECK: } ! CHECK: fir.call @_QPelem_optional_poly(%[[VAL_11]], %[[VAL_12]]) {{.*}} : (!fir.class, !fir.class) -> () ! CHECK: } subroutine test_passing_null() interface subroutine takes_optional_assumed(x) real, optional :: x(:) end subroutine end interface call takes_optional_assumed(null()) ! NULL(MOLD) lowering is a TODO in HLFIR. ! call takes_optional_assumed(null(p)) end subroutine ! CHECK-LABEL: func.func @_QPtest_passing_null() { ! CHECK: %[[VAL_0:.*]] = fir.absent !fir.box> ! CHECK: fir.call @_QPtakes_optional_assumed(%[[VAL_0]]) {{.*}} : (!fir.box>) -> ()