1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s 2! RUN: %flang_fc1 -emit-fir -flang-deprecated-no-hlfir %s -o - | FileCheck %s 3 4! Test intrinsic module procedure c_f_pointer 5 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_2:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> 10! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64> 11! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<i64> 12! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i64) -> !fir.ptr<f32> 13! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_5]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>> 14! CHECK: fir.store %[[VAL_6]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<f32>>> 15! CHECK: return 16! CHECK: } 17 18subroutine test_scalar(cptr, fptr) 19 use iso_c_binding 20 real, pointer :: fptr 21 type(c_ptr) :: cptr 22 23 call c_f_pointer(cptr, fptr) 24end 25 26! CHECK-LABEL: func.func @_QPtest_array( 27! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>> {fir.bindc_name = "cptr"}, 28! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>> {fir.bindc_name = "fptr"}) { 29! CHECK: %[[VAL_65:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> 30! CHECK: %[[VAL_66:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_65]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64> 31! CHECK: %[[VAL_67:.*]] = fir.load %[[VAL_66]] : !fir.ref<i64> 32! CHECK: %[[VAL_68:.*]] = fir.convert %[[VAL_67]] : (i64) -> !fir.ptr<!fir.array<?x?xf32>> 33! CHECK: %[[VAL_69:.*]] = arith.constant 0 : index 34! CHECK: %[[VAL_70:.*]] = fir.coordinate_of %[[VAL_53:.*]], %[[VAL_69]] : (!fir.heap<!fir.array<2xi32>>, index) -> !fir.ref<i32> 35! CHECK: %[[VAL_71:.*]] = fir.load %[[VAL_70]] : !fir.ref<i32> 36! CHECK: %[[VAL_72:.*]] = fir.convert %[[VAL_71]] : (i32) -> index 37! CHECK: %[[VAL_73:.*]] = arith.constant 1 : index 38! CHECK: %[[VAL_74:.*]] = fir.coordinate_of %[[VAL_53]], %[[VAL_73]] : (!fir.heap<!fir.array<2xi32>>, index) -> !fir.ref<i32> 39! CHECK: %[[VAL_75:.*]] = fir.load %[[VAL_74]] : !fir.ref<i32> 40! CHECK: %[[VAL_76:.*]] = fir.convert %[[VAL_75]] : (i32) -> index 41! CHECK: %[[VAL_77:.*]] = fir.shape %[[VAL_72]], %[[VAL_76]] : (index, index) -> !fir.shape<2> 42! 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>>> 43! CHECK: fir.store %[[VAL_78]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>> 44! CHECK: return 45! CHECK: } 46 47subroutine test_array(cptr, fptr) 48 use iso_c_binding 49 real, pointer :: fptr(:,:) 50 type(c_ptr) :: cptr 51 integer :: x = 3, y = 4 52 53 call c_f_pointer(cptr, fptr, [x, y]) 54end 55 56! CHECK-LABEL: func.func @_QPtest_char( 57! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>> {fir.bindc_name = "cptr"}, 58! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,10>>>> {fir.bindc_name = "fptr"}) { 59! CHECK: %[[VAL_2:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> 60! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64> 61! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<i64> 62! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i64) -> !fir.ptr<!fir.char<1,10>> 63! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_5]] : (!fir.ptr<!fir.char<1,10>>) -> !fir.box<!fir.ptr<!fir.char<1,10>>> 64! CHECK: fir.store %[[VAL_6]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,10>>>> 65! CHECK: return 66! CHECK: } 67 68subroutine test_char(cptr, fptr) 69 use iso_c_binding 70 character(10), pointer :: fptr 71 type(c_ptr) :: cptr 72 73 call c_f_pointer(cptr, fptr) 74end 75 76! CHECK-LABEL: func.func @_QPtest_chararray( 77! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>> {fir.bindc_name = "cptr"}, 78! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>> {fir.bindc_name = "fptr"}, 79! CHECK-SAME: %[[VAL_2:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) { 80! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32> 81! CHECK: %[[VAL_8:.*]] = arith.constant 0 : i32 82! CHECK: %[[VAL_9:.*]] = arith.cmpi sgt, %[[VAL_7]], %[[VAL_8]] : i32 83! CHECK: %[[VAL_10:.*]] = arith.select %[[VAL_9]], %[[VAL_7]], %[[VAL_8]] : i32 84! CHECK: %[[VAL_70:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> 85! CHECK: %[[VAL_71:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_70]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64> 86! CHECK: %[[VAL_72:.*]] = fir.load %[[VAL_71]] : !fir.ref<i64> 87! CHECK: %[[VAL_73:.*]] = fir.convert %[[VAL_72]] : (i64) -> !fir.ptr<!fir.array<?x?x!fir.char<1,?>>> 88! CHECK: %[[VAL_74:.*]] = arith.constant 0 : index 89! CHECK: %[[VAL_75:.*]] = fir.coordinate_of %[[VAL_58:.*]], %[[VAL_74]] : (!fir.heap<!fir.array<2xi32>>, index) -> !fir.ref<i32> 90! CHECK: %[[VAL_76:.*]] = fir.load %[[VAL_75]] : !fir.ref<i32> 91! CHECK: %[[VAL_77:.*]] = fir.convert %[[VAL_76]] : (i32) -> index 92! CHECK: %[[VAL_78:.*]] = arith.constant 1 : index 93! CHECK: %[[VAL_79:.*]] = fir.coordinate_of %[[VAL_58]], %[[VAL_78]] : (!fir.heap<!fir.array<2xi32>>, index) -> !fir.ref<i32> 94! CHECK: %[[VAL_80:.*]] = fir.load %[[VAL_79]] : !fir.ref<i32> 95! CHECK: %[[VAL_81:.*]] = fir.convert %[[VAL_80]] : (i32) -> index 96! CHECK: %[[VAL_82:.*]] = fir.shape %[[VAL_77]], %[[VAL_81]] : (index, index) -> !fir.shape<2> 97! 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,?>>>> 98! CHECK: fir.store %[[VAL_83]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>> 99! CHECK: return 100! CHECK: } 101 102subroutine test_chararray(cptr, fptr, n) 103 use iso_c_binding 104 character(n), pointer :: fptr(:,:) 105 type(c_ptr) :: cptr 106 integer :: x = 3, y = 4 107 108 call c_f_pointer(cptr, fptr, [x, y]) 109end 110 111! CHECK-LABEL: func.func @_QPdynamic_shape_size( 112subroutine dynamic_shape_size(cptr, fptr, shape) 113 use iso_c_binding 114 type(c_ptr) :: cptr 115 real, pointer :: fptr(:, :) 116 integer :: shape(:) 117! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index 118! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_7]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32> 119! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_8]] : !fir.ref<i32> 120! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> index 121! CHECK: %[[VAL_11:.*]] = arith.constant 1 : index 122! CHECK: %[[VAL_12:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_11]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32> 123! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_12]] : !fir.ref<i32> 124! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i32) -> index 125! CHECK: %[[VAL_15:.*]] = fir.shape %[[VAL_10]], %[[VAL_14]] : (index, index) -> !fir.shape<2> 126 call c_f_pointer(cptr, fptr, shape) 127end subroutine 128 129! CHECK-LABEL: func.func @_QPdynamic_shape_size_2( 130subroutine dynamic_shape_size_2(cptr, fptr, shape, n) 131 use iso_c_binding 132 type(c_ptr) :: cptr 133 real, pointer :: fptr(:, :) 134 integer :: n 135 integer :: shape(n) 136! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index 137! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_8]] : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32> 138! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_9]] : !fir.ref<i32> 139! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i32) -> index 140! CHECK: %[[VAL_12:.*]] = arith.constant 1 : index 141! CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_12]] : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32> 142! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_13]] : !fir.ref<i32> 143! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i32) -> index 144! CHECK: %[[VAL_16:.*]] = fir.shape %[[VAL_11]], %[[VAL_15]] : (index, index) -> !fir.shape<2> 145 call c_f_pointer(cptr, fptr, shape) 146end subroutine 147