217 lines · plain
1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s2! RUN: %flang_fc1 -emit-fir -flang-deprecated-no-hlfir %s -o - | FileCheck %s3 4! Test intrinsic module procedure c_f_pointer5 6! CHECK-LABEL: func.func @_QPtest_scalar(7! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>> {fir.bindc_name = "cptr"},8! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>> {fir.bindc_name = "fptr"}) {9! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], __address : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>) -> !fir.ref<i64>10! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<i64>11! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i64) -> !fir.ptr<f32>12! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_5]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>13! CHECK: fir.store %[[VAL_6]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<f32>>>14! CHECK: return15! CHECK: }16 17subroutine test_scalar(cptr, fptr)18 use iso_c_binding19 real, pointer :: fptr20 type(c_ptr) :: cptr21 22 call c_f_pointer(cptr, fptr)23end24 25! CHECK-LABEL: func.func @_QPtest_array(26! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>> {fir.bindc_name = "cptr"},27! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>> {fir.bindc_name = "fptr"}) {28! CHECK: %[[VAL_66:.*]] = fir.coordinate_of %[[VAL_0]], __address : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>) -> !fir.ref<i64>29! CHECK: %[[VAL_67:.*]] = fir.load %[[VAL_66]] : !fir.ref<i64>30! CHECK: %[[VAL_68:.*]] = fir.convert %[[VAL_67]] : (i64) -> !fir.ptr<!fir.array<?x?xf32>>31! CHECK: %[[VAL_69:.*]] = arith.constant 0 : index32! CHECK: %[[VAL_70:.*]] = fir.coordinate_of %[[VAL_53:.*]], %[[VAL_69]] : (!fir.heap<!fir.array<2xi32>>, index) -> !fir.ref<i32>33! CHECK: %[[VAL_71:.*]] = fir.load %[[VAL_70]] : !fir.ref<i32>34! CHECK: %[[VAL_72:.*]] = fir.convert %[[VAL_71]] : (i32) -> index35! CHECK: %[[VAL_73:.*]] = arith.constant 1 : index36! CHECK: %[[VAL_74:.*]] = fir.coordinate_of %[[VAL_53]], %[[VAL_73]] : (!fir.heap<!fir.array<2xi32>>, index) -> !fir.ref<i32>37! CHECK: %[[VAL_75:.*]] = fir.load %[[VAL_74]] : !fir.ref<i32>38! CHECK: %[[VAL_76:.*]] = fir.convert %[[VAL_75]] : (i32) -> index39! CHECK: %[[VAL_77:.*]] = fir.shape %[[VAL_72]], %[[VAL_76]] : (index, index) -> !fir.shape<2>40! CHECK: %[[VAL_78:.*]] = fir.embox %[[VAL_68]](%[[VAL_77]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>41! CHECK: fir.store %[[VAL_78]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>42! CHECK: return43! CHECK: }44 45subroutine test_array(cptr, fptr)46 use iso_c_binding47 real, pointer :: fptr(:,:)48 type(c_ptr) :: cptr49 integer :: x = 3, y = 450 51 call c_f_pointer(cptr, fptr, [x, y])52end53 54! CHECK-LABEL: func.func @_QPtest_char(55! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>> {fir.bindc_name = "cptr"},56! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,10>>>> {fir.bindc_name = "fptr"}) {57! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], __address : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>) -> !fir.ref<i64>58! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<i64>59! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i64) -> !fir.ptr<!fir.char<1,10>>60! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_5]] : (!fir.ptr<!fir.char<1,10>>) -> !fir.box<!fir.ptr<!fir.char<1,10>>>61! CHECK: fir.store %[[VAL_6]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,10>>>>62! CHECK: return63! CHECK: }64 65subroutine test_char(cptr, fptr)66 use iso_c_binding67 character(10), pointer :: fptr68 type(c_ptr) :: cptr69 70 call c_f_pointer(cptr, fptr)71end72 73! CHECK-LABEL: func.func @_QPtest_chararray(74! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>> {fir.bindc_name = "cptr"},75! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>> {fir.bindc_name = "fptr"},76! CHECK-SAME: %[[VAL_2:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) {77! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>78! CHECK: %[[VAL_8:.*]] = arith.constant 0 : i3279! CHECK: %[[VAL_9:.*]] = arith.cmpi sgt, %[[VAL_7]], %[[VAL_8]] : i3280! CHECK: %[[VAL_10:.*]] = arith.select %[[VAL_9]], %[[VAL_7]], %[[VAL_8]] : i3281! CHECK: %[[VAL_71:.*]] = fir.coordinate_of %[[VAL_0]], __address : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>) -> !fir.ref<i64>82! CHECK: %[[VAL_72:.*]] = fir.load %[[VAL_71]] : !fir.ref<i64>83! CHECK: %[[VAL_73:.*]] = fir.convert %[[VAL_72]] : (i64) -> !fir.ptr<!fir.array<?x?x!fir.char<1,?>>>84! CHECK: %[[VAL_74:.*]] = arith.constant 0 : index85! CHECK: %[[VAL_75:.*]] = fir.coordinate_of %[[VAL_58:.*]], %[[VAL_74]] : (!fir.heap<!fir.array<2xi32>>, index) -> !fir.ref<i32>86! CHECK: %[[VAL_76:.*]] = fir.load %[[VAL_75]] : !fir.ref<i32>87! CHECK: %[[VAL_77:.*]] = fir.convert %[[VAL_76]] : (i32) -> index88! CHECK: %[[VAL_78:.*]] = arith.constant 1 : index89! CHECK: %[[VAL_79:.*]] = fir.coordinate_of %[[VAL_58]], %[[VAL_78]] : (!fir.heap<!fir.array<2xi32>>, index) -> !fir.ref<i32>90! CHECK: %[[VAL_80:.*]] = fir.load %[[VAL_79]] : !fir.ref<i32>91! CHECK: %[[VAL_81:.*]] = fir.convert %[[VAL_80]] : (i32) -> index92! CHECK: %[[VAL_82:.*]] = fir.shape %[[VAL_77]], %[[VAL_81]] : (index, index) -> !fir.shape<2>93! CHECK: %[[VAL_83:.*]] = fir.embox %[[VAL_73]](%[[VAL_82]]) typeparams %[[VAL_10]] : (!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>, !fir.shape<2>, i32) -> !fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>94! CHECK: fir.store %[[VAL_83]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>95! CHECK: return96! CHECK: }97 98subroutine test_chararray(cptr, fptr, n)99 use iso_c_binding100 character(n), pointer :: fptr(:,:)101 type(c_ptr) :: cptr102 integer :: x = 3, y = 4103 104 call c_f_pointer(cptr, fptr, [x, y])105end106 107! CHECK-LABEL: func.func @_QPdynamic_shape_size(108subroutine dynamic_shape_size(cptr, fptr, shape)109 use iso_c_binding110 type(c_ptr) :: cptr111 real, pointer :: fptr(:, :)112 integer :: shape(:)113! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index114! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_7]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>115! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_8]] : !fir.ref<i32>116! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> index117! CHECK: %[[VAL_11:.*]] = arith.constant 1 : index118! CHECK: %[[VAL_12:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_11]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>119! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_12]] : !fir.ref<i32>120! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i32) -> index121! CHECK: %[[VAL_15:.*]] = fir.shape %[[VAL_10]], %[[VAL_14]] : (index, index) -> !fir.shape<2>122 call c_f_pointer(cptr, fptr, shape)123end subroutine124 125! CHECK-LABEL: func.func @_QPdynamic_shape_size_2(126subroutine dynamic_shape_size_2(cptr, fptr, shape, n)127 use iso_c_binding128 type(c_ptr) :: cptr129 real, pointer :: fptr(:, :)130 integer :: n131 integer :: shape(n)132! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index133! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_8]] : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>134! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_9]] : !fir.ref<i32>135! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i32) -> index136! CHECK: %[[VAL_12:.*]] = arith.constant 1 : index137! CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_12]] : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>138! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_13]] : !fir.ref<i32>139! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i32) -> index140! CHECK: %[[VAL_16:.*]] = fir.shape %[[VAL_11]], %[[VAL_15]] : (index, index) -> !fir.shape<2>141 call c_f_pointer(cptr, fptr, shape)142end subroutine143 144! CHECK-LABEL: func.func @_QPdynamic_shape_lower(145subroutine dynamic_shape_lower(cptr, fpr, shape, lower)146 use iso_c_binding147 type(c_ptr) :: cptr148 real, pointer :: fptr(:, :)149 integer :: n150 integer :: shape(:)151 integer :: lower(:)152! CHECK: %[[C_0:.*]] = arith.constant 0 : index153! CHECK: %[[VAL_2:.*]] = fir.shape %[[C_0]], %[[C_0]] : (index, index) -> !fir.shape<2>154! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_1:.*]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>155! CHECK: fir.store %[[VAL_3]] to %[[VAL_0:.*]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>156! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[ARG_0:.*]], __address : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>) -> !fir.ref<i64>157! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.ref<i64>158! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> !fir.ptr<!fir.array<?x?xf32>>159! CHECK: %[[C_0:.*]]_0 = arith.constant 0 : index160! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[ARG_2:.*]], %[[C_0]]_0 : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>161! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_8]] : !fir.ref<i32>162! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> index163! CHECK: %[[C_1:.*]] = arith.constant 1 : index164! CHECK: %[[VAL_11:.*]] = fir.coordinate_of %[[ARG_2:.*]], %[[C_1]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>165! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_11]] : !fir.ref<i32>166! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i32) -> index167! CHECK: %[[C_0:.*]]_1 = arith.constant 0 : index168! CHECK: %[[VAL_14:.*]] = fir.coordinate_of %[[ARG_3:.*]], %[[C_0]]_1 : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>169! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_14]] : !fir.ref<i32>170! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i32) -> index171! CHECK: %[[C_1:.*]]_2 = arith.constant 1 : index172! CHECK: %[[VAL_17:.*]] = fir.coordinate_of %[[ARG_3:.*]], %[[C_1]]_2 : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>173! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_17]] : !fir.ref<i32>174! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (i32) -> index175! CHECK: %[[VAL_20:.*]] = fir.shape_shift %[[VAL_16]], %[[VAL_10]], %[[VAL_19]], %[[VAL_13]] : (index, index, index, index) -> !fir.shapeshift<2>176! CHECK: %[[VAL_21:.*]] = fir.embox %[[VAL_7]](%[[VAL_20]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>177! CHECK: fir.store %[[VAL_21:.*]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>178 call c_f_pointer(cptr, fptr, shape, lower)179end subroutine dynamic_shape_lower180 181! CHECK-LABEL: func.func @_QPdynamic_shape_lower_2(182subroutine dynamic_shape_lower_2(cptr, fpr, shape, lower, n)183 use iso_c_binding184 type(c_ptr) :: cptr185 real, pointer :: fptr(:, :)186 integer :: n187 integer :: shape(n)188 integer :: lower(n)189!CHECK: %[[C_0:.*]] = arith.constant 0 : index190!CHECK: %[[VAL_2:.*]] = fir.shape %[[C_0]], %[[C_0]] : (index, index) -> !fir.shape<2>191!CHECK: %[[VAL_3:.*]] = fir.embox %[[ARG1:.*]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>192!CHECK: fir.store %[[VAL_3]] to %[[VAL_0:.*]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>193!CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[ARG_0:.*]], __address : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>) -> !fir.ref<i64>194!CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i64>195!CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> !fir.ptr<!fir.array<?x?xf32>>196!CHECK: %[[C_0:.*]]_0 = arith.constant 0 : index197!CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[ARG_2:.*]], %[[C_0]]_0 : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>198!CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]] : !fir.ref<i32>199!CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i32) -> index200!CHECK: %[[C_1:.*]] = arith.constant 1 : index201!CHECK: %[[VAL_10:.*]] = fir.coordinate_of %[[ARG_2]], %[[C_1]] : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>202!CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_10]] : !fir.ref<i32>203!CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i32) -> index204!CHECK: %[[C_0:.*]]_1 = arith.constant 0 : index205!CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[ARG_3:.*]], %[[C_0]]_1 : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>206!CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_13]] : !fir.ref<i32>207!CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i32) -> index208!CHECK: %[[C_1:.*]]_2 = arith.constant 1 : index209!CHECK: %[[VAL_16:.*]] = fir.coordinate_of %[[ARG_3]], %[[C_1]]_2 : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>210!CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_16]] : !fir.ref<i32>211!CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i32) -> index212!CHECK: %[[VAL_19:.*]] = fir.shape_shift %[[VAL_15]], %[[VAL_9]], %[[VAL_18]], %[[VAL_12]] : (index, index, index, index) -> !fir.shapeshift<2>213!CHECK: %[[VAL_20:.*]] = fir.embox %[[VAL_6]](%[[VAL_19]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shapeshift<2>)214!CHECK: fir.store %[[VAL_20]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>215 call c_f_pointer(cptr, fptr, shape, lower)216end subroutine dynamic_shape_lower_2217