flang/test/Lower/Intrinsics/c_f_pointer.f90

   1 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
   2 ! RUN: %flang_fc1 -emit-fir %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
  18 subroutine 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)
  24 end
  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
  47 subroutine 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])
  54 end
  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
  68 subroutine 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)
  74 end
  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
 102 subroutine 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])
 109 end
 110
 111 ! CHECK-LABEL: func.func @_QPdynamic_shape_size(
 112 subroutine 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)
 127 end subroutine
 128
 129 ! CHECK-LABEL: func.func @_QPdynamic_shape_size_2(
 130 subroutine 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)
 146 end subroutine