436 lines · plain
1! Test passing pointer, allocatables, and optional assumed shapes to optional2! explicit shapes (see F2018 15.5.2.12).3! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s4module optional_tests5implicit none6interface7subroutine takes_opt_scalar(i)8 integer, optional :: i9end subroutine10subroutine takes_opt_scalar_char(c)11 character(*), optional :: c12end subroutine13subroutine takes_opt_explicit_shape(x)14 real, optional :: x(100)15end subroutine16subroutine takes_opt_explicit_shape_intentout(x)17 real, optional, intent(out) :: x(100)18end subroutine19subroutine takes_opt_explicit_shape_intentin(x)20 real, optional, intent(in) :: x(100)21end subroutine22subroutine takes_opt_explicit_shape_char(c)23 character(*), optional :: c(100)24end subroutine25function returns_pointer()26 real, pointer :: returns_pointer(:)27end function28end interface29contains30 31! -----------------------------------------------------------------------------32! Test passing scalar pointers and allocatables to an optional33! -----------------------------------------------------------------------------34! Here, nothing optional specific is expected, the address is passed, and its35! allocation/association status match the dummy presence status.36 37! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_scalar(38! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<i32>>>{{.*}}) {39subroutine pass_pointer_scalar(i)40 integer, pointer :: i41 call takes_opt_scalar(i)42! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<i32>>>43! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>44! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<i32>) -> !fir.ref<i32>45! CHECK: fir.call @_QPtakes_opt_scalar(%[[VAL_3]]) {{.*}}: (!fir.ref<i32>) -> ()46end subroutine47 48! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_scalar(49! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<i32>>>{{.*}}) {50subroutine pass_allocatable_scalar(i)51 integer, allocatable :: i52 call takes_opt_scalar(i)53! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<i32>>>54! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<i32>>) -> !fir.heap<i32>55! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.heap<i32>) -> !fir.ref<i32>56! CHECK: fir.call @_QPtakes_opt_scalar(%[[VAL_3]]) {{.*}}: (!fir.ref<i32>) -> ()57end subroutine58 59! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_scalar_char(60! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>{{.*}}) {61subroutine pass_pointer_scalar_char(c)62 character(:), pointer :: c63 call takes_opt_scalar_char(c)64! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>65! CHECK: %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index66! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.ptr<!fir.char<1,?>>67! CHECK: %[[VAL_5:.*]] = fir.emboxchar %[[VAL_3]], %[[VAL_2]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.boxchar<1>68! CHECK: fir.call @_QPtakes_opt_scalar_char(%[[VAL_5]]) {{.*}}: (!fir.boxchar<1>) -> ()69end subroutine70 71! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_scalar_char(72! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>{{.*}}) {73subroutine pass_allocatable_scalar_char(c)74 character(:), allocatable :: c75 call takes_opt_scalar_char(c)76! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>77! CHECK: %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> index78! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>79! CHECK: %[[VAL_5:.*]] = fir.emboxchar %[[VAL_3]], %[[VAL_2]] : (!fir.heap<!fir.char<1,?>>, index) -> !fir.boxchar<1>80! CHECK: fir.call @_QPtakes_opt_scalar_char(%[[VAL_5]]) {{.*}}: (!fir.boxchar<1>) -> ()81end subroutine82 83! -----------------------------------------------------------------------------84! Test passing non contiguous pointers to explicit shape optional85! -----------------------------------------------------------------------------86! The pointer descriptor can be unconditionally read, but the copy-in/copy-out87! must be conditional on the pointer association status in order to get the88! correct present/absent aspect.89 90! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_array(91! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}) {92subroutine pass_pointer_array(i)93 real, pointer :: i(:)94 call takes_opt_explicit_shape(i)95! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>96! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>97! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> i6498! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i6499! CHECK: %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64100! CHECK: %[[box:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>101! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index102! CHECK: %[[box_none:.*]] = fir.convert %[[box]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>103! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1104! CHECK: %[[VAL_9:.*]] = fir.if %[[VAL_5]] -> (!fir.heap<!fir.array<?xf32>>) {105! CHECK: %[[addr:.*]] = fir.if %[[is_contiguous]] -> (!fir.heap<!fir.array<?xf32>>) {106! CHECK: %[[box_addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>107! CHECK: fir.result %[[box_addr]] : !fir.heap<!fir.array<?xf32>>108! CHECK: } else {109! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index110! CHECK: %[[VAL_11:.*]]:3 = fir.box_dims %[[box]], %[[VAL_10]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)111! CHECK: %[[VAL_12:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_11]]#1 {uniq_name = ".copyinout"}112! CHECK: fir.call @_FortranAAssignTemporary113! CHECK: fir.result %[[VAL_12]] : !fir.heap<!fir.array<?xf32>>114! CHECK: } else {115! CHECK: %[[VAL_26:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>116! CHECK: fir.result %[[VAL_26]] : !fir.heap<!fir.array<?xf32>>117! CHECK: }118! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1119! CHECK: %[[and:.*]] = arith.andi %[[VAL_5]], %[[not_contiguous]] : i1120! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_9]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>121! CHECK: fir.call @_QPtakes_opt_explicit_shape(%[[VAL_29]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()122! CHECK: fir.if %[[and]] {123! CHECK: fir.call @_FortranACopyOutAssign124! CHECK: }125end subroutine126 127! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_array_char(128! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>{{.*}}) {129subroutine pass_pointer_array_char(c)130 character(:), pointer :: c(:)131 call takes_opt_explicit_shape_char(c)132! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>133! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> !fir.ptr<!fir.array<?x!fir.char<1,?>>>134! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>) -> i64135! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i64136! CHECK: %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64137! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>138! CHECK: %[[box_none:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> !fir.box<none>139! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1140! CHECK: %[[VAL_9:.*]] = fir.if %[[VAL_5]] -> (!fir.heap<!fir.array<?x!fir.char<1,?>>>) {141! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index142! CHECK: %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_10]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>, index) -> (index, index, index)143! CHECK: %[[VAL_12:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index144! CHECK: %[[VAL_13:.*]] = fir.allocmem !fir.array<?x!fir.char<1,?>>(%[[VAL_12]] : index), %[[VAL_11]]#1 {uniq_name = ".copyinout"}145! CHECK: fir.call @_FortranAAssignTemporary146! CHECK: fir.result %[[VAL_13]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>147! CHECK: } else {148! CHECK: %[[VAL_46:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1,?>>>149! CHECK: fir.result %[[VAL_46]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>150! CHECK: }151! CHECK: %[[VAL_47:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index152! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1153! CHECK: %[[and:.*]] = arith.andi %[[VAL_5]], %[[not_contiguous]] : i1154! CHECK: %[[VAL_50:.*]] = fir.convert %[[VAL_9]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>155! CHECK: %[[VAL_52:.*]] = fir.emboxchar %[[VAL_50]], %[[VAL_47]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>156! CHECK: fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_52]]) {{.*}}: (!fir.boxchar<1>) -> ()157! CHECK: fir.if %[[and]] {158! CHECK: fir.call @_FortranACopyOutAssign159! CHECK: }160! CHECK: return161! CHECK: }162end subroutine163 164! This case is bit special because the pointer is not a symbol but a function165! result. Test that the copy-in/copy-out is the same as with normal pointers.166 167! CHECK-LABEL: func @_QMoptional_testsPforward_pointer_array() {168subroutine forward_pointer_array()169 call takes_opt_explicit_shape(returns_pointer())170! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = ".result"}171! CHECK: %[[VAL_1:.*]] = fir.call @_QPreturns_pointer() {{.*}}: () -> !fir.box<!fir.ptr<!fir.array<?xf32>>>172! CHECK: fir.save_result %[[VAL_1]] to %[[VAL_0]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>173! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>174! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>175! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.array<?xf32>>) -> i64176! CHECK: %[[VAL_5:.*]] = arith.constant 0 : i64177! CHECK: %[[VAL_6:.*]] = arith.cmpi ne, %[[VAL_4]], %[[VAL_5]] : i64178! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%{{.*}}) {{.*}}: (!fir.box<none>) -> i1179! CHECK: %[[VAL_7:.*]] = fir.if %[[VAL_6]] -> (!fir.heap<!fir.array<?xf32>>) {180! CHECK: %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>181! CHECK: fir.call @_FortranAAssignTemporary182! CHECK: fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>183! CHECK: } else {184! CHECK: %[[VAL_11:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>185! CHECK: fir.result %[[VAL_11]] : !fir.heap<!fir.array<?xf32>>186! CHECK: }187! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1188! CHECK: %[[and:.*]] = arith.andi %[[VAL_6]], %[[not_contiguous]] : i1189! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>190! CHECK: fir.call @_QPtakes_opt_explicit_shape(%[[VAL_14]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()191! CHECK: fir.if %[[and]] {192! CHECK: fir.call @_FortranACopyOutAssign193! CHECK: }194end subroutine195 196! -----------------------------------------------------------------------------197! Test passing assumed shape optional to explicit shape optional198! -----------------------------------------------------------------------------199! The fix.box can only be read if the assumed shape is present,200! and the copy-in/copy-out must also be conditional on the assumed201! shape presence.202 203! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape(204! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {205subroutine pass_opt_assumed_shape(x)206 real, optional :: x(:)207 call takes_opt_explicit_shape(x)208! CHECK: %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1209! CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>210! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index211! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>212! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>213! CHECK: %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>214! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%{{.*}}) {{.*}}: (!fir.box<none>) -> i1215! CHECK: %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {216! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index217! CHECK: %[[VAL_9:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_8]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)218! CHECK: %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_9]]#1 {uniq_name = ".copyinout"}219! CHECK: fir.call @_FortranAAssignTemporary220! CHECK: fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>221! CHECK: } else {222! CHECK: %[[VAL_23:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>223! CHECK: fir.result %[[VAL_23]] : !fir.heap<!fir.array<?xf32>>224! CHECK: }225! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1226! CHECK: %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1227! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_27:.*]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>228! CHECK: fir.call @_QPtakes_opt_explicit_shape(%[[VAL_26]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()229! CHECK: fir.if %[[and]] {230! CHECK: fir.call @_FortranACopyOutAssign231! CHECK: }232end subroutine233 234! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape_char(235! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c", fir.optional}) {236subroutine pass_opt_assumed_shape_char(c)237 character(*), optional :: c(:)238 call takes_opt_explicit_shape_char(c)239! CHECK: %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> i1240! CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?x!fir.char<1,?>>>241! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index242! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>243! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index244! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) typeparams %[[VAL_5]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,?>>>245! CHECK: %[[VAL_7:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_6]] : !fir.box<!fir.array<?x!fir.char<1,?>>>246! CHECK: %[[box_none:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.box<none>247! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1248! CHECK: %[[VAL_8:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?x!fir.char<1,?>>>) {249! CHECK: %[[addr:.*]] = fir.if %[[is_contiguous]] -> (!fir.heap<!fir.array<?x!fir.char<1,?>>>) {250! CHECK: %[[res:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>>251! CHECK: fir.result %[[res]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>252! CHECK: } else {253! CHECK: %[[box_elesize:.*]] = fir.box_elesize %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index254! CHECK: %[[temp:.*]] = fir.allocmem !fir.array<?x!fir.char<1,?>>(%[[box_elesize]] : index), %{{.*}}#1 {uniq_name = ".copyinout"}255! CHECK: fir.call @_FortranAAssignTemporary256! CHECK: fir.result %[[VAL_12]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>257! CHECK: } else {258! CHECK: %[[VAL_44:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1,?>>>259! CHECK: fir.result %[[VAL_44]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>260! CHECK: }261! CHECK: %[[VAL_45:.*]] = fir.box_elesize %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index262! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1263! CHECK: %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1264! CHECK: %[[VAL_48:.*]] = fir.convert %[[VAL_49:.*]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>265! CHECK: %[[VAL_50:.*]] = fir.emboxchar %[[VAL_48]], %[[VAL_45]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>266! CHECK: fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_50]]) {{.*}}: (!fir.boxchar<1>) -> ()267! CHECK: fir.if %[[and]] {268! CHECK: fir.call @_FortranACopyOutAssign269! CHECK: }270end subroutine271 272! -----------------------------------------------------------------------------273! Test passing contiguous optional assumed shape to explicit shape optional274! -----------------------------------------------------------------------------275! The fix.box can only be read if the assumed shape is present.276! There should be no copy-in/copy-out277 278! CHECK-LABEL: func @_QMoptional_testsPpass_opt_contiguous_assumed_shape(279! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous, fir.optional}) {280subroutine pass_opt_contiguous_assumed_shape(x)281 real, optional, contiguous :: x(:)282 call takes_opt_explicit_shape(x)283! CHECK: %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1284! CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>285! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index286! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>287! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>288! CHECK: %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>289! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>290! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>291! CHECK: fir.call @_QPtakes_opt_explicit_shape(%[[VAL_8]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()292end subroutine293 294! CHECK-LABEL: func @_QMoptional_testsPpass_opt_contiguous_assumed_shape_char(295! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c", fir.contiguous, fir.optional}) {296subroutine pass_opt_contiguous_assumed_shape_char(c)297 character(*), optional, contiguous :: c(:)298 call takes_opt_explicit_shape_char(c)299! CHECK: %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> i1300! CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?x!fir.char<1,?>>>301! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index302! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>303! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index304! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) typeparams %[[VAL_5]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,?>>>305! CHECK: %[[VAL_7:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_6]] : !fir.box<!fir.array<?x!fir.char<1,?>>>306! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>307! CHECK: %[[VAL_9:.*]] = fir.box_elesize %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index308! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>309! CHECK: %[[VAL_11:.*]] = fir.emboxchar %[[VAL_10]], %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>310! CHECK: fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_11]]) {{.*}}: (!fir.boxchar<1>) -> ()311end subroutine312 313! -----------------------------------------------------------------------------314! Test passing allocatables and contiguous pointers to explicit shape optional315! -----------------------------------------------------------------------------316! The fix.box can be read and its address directly passed. There should be no317! copy-in/copy-out.318 319! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_array(320! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>{{.*}}) {321subroutine pass_allocatable_array(i)322 real, allocatable :: i(:)323 call takes_opt_explicit_shape(i)324! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>325! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>326! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>327! CHECK: fir.call @_QPtakes_opt_explicit_shape(%[[VAL_3]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()328end subroutine329 330! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_array_char(331! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>{{.*}}) {332subroutine pass_allocatable_array_char(c)333 character(:), allocatable :: c(:)334 call takes_opt_explicit_shape_char(c)335! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>336! CHECK: %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> index337! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>>338! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>339! CHECK: %[[VAL_5:.*]] = fir.emboxchar %[[VAL_4]], %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>340! CHECK: fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_5]]) {{.*}}: (!fir.boxchar<1>) -> ()341end subroutine342 343! CHECK-LABEL: func @_QMoptional_testsPpass_contiguous_pointer_array(344! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "i", fir.contiguous}) {345subroutine pass_contiguous_pointer_array(i)346 real, pointer, contiguous :: i(:)347 call takes_opt_explicit_shape(i)348! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>349! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>350! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>351! CHECK: fir.call @_QPtakes_opt_explicit_shape(%[[VAL_3]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()352end subroutine353 354! CHECK-LABEL: func @_QMoptional_testsPpass_contiguous_pointer_array_char(355! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>> {fir.bindc_name = "c", fir.contiguous}) {356subroutine pass_contiguous_pointer_array_char(c)357 character(:), pointer, contiguous :: c(:)358 call takes_opt_explicit_shape_char(c)359! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>360! CHECK: %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index361! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> !fir.ptr<!fir.array<?x!fir.char<1,?>>>362! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>363! CHECK: %[[VAL_5:.*]] = fir.emboxchar %[[VAL_4]], %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>364! CHECK: fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_5]]) {{.*}}: (!fir.boxchar<1>) -> ()365end subroutine366 367! -----------------------------------------------------------------------------368! Test passing assumed shape optional to explicit shape optional with intents369! -----------------------------------------------------------------------------370! The fix.box can only be read if the assumed shape is present,371! and the copy-in/copy-out must also be conditional on the assumed372! shape presence. For intent(in), there should be no copy-out while for373! intent(out), there should be no copy-in.374 375! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape_to_intentin(376! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {377subroutine pass_opt_assumed_shape_to_intentin(x)378 real, optional :: x(:)379 call takes_opt_explicit_shape_intentin(x)380! CHECK: %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1381! CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>382! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index383! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>384! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>385! CHECK: %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>386! CHECK: %[[box_none:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>387! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1388! CHECK: %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {389! CHECK: %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>390! CHECK: fir.call @_FortranAAssignTemporary391! CHECK: fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>392! CHECK: } else {393! CHECK: %[[VAL_23:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>394! CHECK: fir.result %[[VAL_23]] : !fir.heap<!fir.array<?xf32>>395! CHECK: }396! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1397! CHECK: %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1398! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>399! CHECK: fir.call @_QPtakes_opt_explicit_shape_intentin(%[[VAL_24]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()400! CHECK: fir.if %[[and]] {401! CHECK: fir.zero402! CHECK: fir.call @_FortranACopyOutAssign403! CHECK: }404end subroutine405 406! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape_to_intentout(407! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {408subroutine pass_opt_assumed_shape_to_intentout(x)409 real, optional :: x(:)410 call takes_opt_explicit_shape_intentout(x)411! CHECK: %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1412! CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>413! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index414! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>415! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>416! CHECK: %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>417! CHECK: %[[box_none:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>418! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1419! CHECK: %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {420! CHECK: %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>421! CHECK-NOT: fir.call @_FortranAAssignTemporary422! CHECK: fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>423! CHECK: } else {424! CHECK: %[[VAL_11:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>425! CHECK: fir.result %[[VAL_11]] : !fir.heap<!fir.array<?xf32>>426! CHECK: }427! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1428! CHECK: %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1429! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>430! CHECK: fir.call @_QPtakes_opt_explicit_shape_intentout(%[[VAL_14]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()431! CHECK: fir.if %[[and]] {432! CHECK: fir.call @_FortranACopyOutAssign433! CHECK: }434end subroutine435end module436