flang/test/Lower/HLFIR/allocatable-and-pointer-components.f90

   1 ! Test lowering of whole allocatable and pointer components to HLFIR
   2 ! RUN: bbc -emit-fir -hlfir -o - %s -I nw | FileCheck %s
   3
   4 module def_test_types
   5   type t1
   6     real, pointer :: p(:)
   7   end type
   8   type t2
   9     real, allocatable :: a(:)
  10   end type
  11   type t3
  12     real, pointer, contiguous :: p_contiguous(:)
  13   end type
  14   type t4
  15     character(:), pointer :: char_p(:)
  16   end type
  17   type t5
  18     character(10), allocatable :: char_a(:)
  19   end type
  20   interface
  21     subroutine takes_pointer(y)
  22       real, pointer :: y(:)
  23     end subroutine
  24     subroutine takes_contiguous_pointer(y)
  25       real, pointer, contiguous :: y(:)
  26     end subroutine
  27     subroutine takes_allocatable(y)
  28       real, allocatable :: y(:)
  29     end subroutine
  30     subroutine takes_char_pointer(y)
  31       character(:), pointer :: y(:)
  32     end subroutine
  33     subroutine takes_char_alloc_cst_len(y)
  34       character(10), allocatable :: y(:)
  35     end subroutine
  36     subroutine takes_array(y)
  37       real :: y(*)
  38     end subroutine
  39     subroutine takes_char_array(y)
  40       character(*) :: y(*)
  41     end subroutine
  42
  43   end interface
  44 end module
  45
  46 subroutine passing_pointer(x)
  47   use  def_test_types
  48   implicit none
  49   type(t1) :: x
  50   call takes_pointer(x%p)
  51 end subroutine
  52 ! CHECK-LABEL: func.func @_QPpassing_pointer(
  53 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ex
  54 ! CHECK:  %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"p"}   {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMdef_test_typesTt1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
  55 ! CHECK:  fir.call @_QPtakes_pointer(%[[VAL_2]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> ()
  56
  57 subroutine passing_allocatable(x)
  58   use  def_test_types
  59   implicit none
  60   type(t2) :: x
  61   call takes_allocatable(x%a)
  62   call takes_array(x%a)
  63 end subroutine
  64 ! CHECK-LABEL: func.func @_QPpassing_allocatable(
  65 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ex
  66 ! CHECK:  %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"a"}   {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QMdef_test_typesTt2{a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
  67 ! CHECK:  fir.call @_QPtakes_allocatable(%[[VAL_2]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
  68 ! CHECK:  %[[VAL_3:.*]] = hlfir.designate %[[VAL_1]]#0{"a"}   {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QMdef_test_typesTt2{a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
  69 ! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
  70 ! CHECK:  %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
  71 ! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
  72 ! CHECK:  fir.call @_QPtakes_array(%[[VAL_6]]) {{.*}}: (!fir.ref<!fir.array<?xf32>>) -> ()
  73
  74 subroutine passing_contiguous_pointer(x)
  75   use  def_test_types
  76   type(t3) :: x
  77   call takes_contiguous_pointer(x%p_contiguous)
  78   call takes_array(x%p_contiguous)
  79 end subroutine
  80 ! CHECK-LABEL: func.func @_QPpassing_contiguous_pointer(
  81 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ex
  82 ! CHECK:  %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"p_contiguous"}   {fortran_attrs = #fir.var_attrs<contiguous, pointer>} : (!fir.ref<!fir.type<_QMdef_test_typesTt3{p_contiguous:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
  83 ! CHECK:  fir.call @_QPtakes_contiguous_pointer(%[[VAL_2]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> ()
  84 ! CHECK:  %[[VAL_3:.*]] = hlfir.designate %[[VAL_1]]#0{"p_contiguous"}   {fortran_attrs = #fir.var_attrs<contiguous, pointer>} : (!fir.ref<!fir.type<_QMdef_test_typesTt3{p_contiguous:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
  85 ! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
  86 ! CHECK:  %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
  87 ! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.ptr<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
  88 ! CHECK:  fir.call @_QPtakes_array(%[[VAL_6]]) {{.*}}: (!fir.ref<!fir.array<?xf32>>) -> ()
  89
  90 subroutine passing_char_pointer(x)
  91   use  def_test_types
  92   implicit none
  93   type(t4) :: x
  94   call takes_char_pointer(x%char_p)
  95 end subroutine
  96 ! CHECK-LABEL: func.func @_QPpassing_char_pointer(
  97 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ex
  98 ! CHECK:  %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"char_p"}   {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMdef_test_typesTt4{char_p:!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>}>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
  99 ! CHECK:  fir.call @_QPtakes_char_pointer(%[[VAL_2]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> ()
 100
 101 subroutine passing_char_alloc_cst_len(x)
 102   use  def_test_types
 103   implicit none
 104   type(t5) :: x
 105   call takes_char_alloc_cst_len(x%char_a)
 106   call takes_char_array(x%char_a)
 107 end subroutine
 108 ! CHECK-LABEL: func.func @_QPpassing_char_alloc_cst_len(
 109 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ex
 110 ! CHECK:  %[[VAL_2:.*]] = arith.constant 10 : index
 111 ! CHECK:  %[[VAL_3:.*]] = hlfir.designate %[[VAL_1]]#0{"char_a"}   typeparams %[[VAL_2]] {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QMdef_test_typesTt5{char_a:!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>}>>, index) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>
 112 ! CHECK:  fir.call @_QPtakes_char_alloc_cst_len(%[[VAL_3]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>) -> ()
 113 ! CHECK:  %[[VAL_4:.*]] = arith.constant 10 : index
 114 ! CHECK:  %[[VAL_5:.*]] = hlfir.designate %[[VAL_1]]#0{"char_a"}   typeparams %[[VAL_4]] {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QMdef_test_typesTt5{char_a:!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>}>>, index) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>
 115 ! CHECK:  %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>
 116 ! CHECK:  %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,10>>>
 117 ! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?x!fir.char<1,10>>>) -> !fir.ref<!fir.char<1,10>>
 118 ! CHECK:  %[[VAL_9:.*]] = fir.emboxchar %[[VAL_8]], %[[VAL_4]] : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>
 119 ! CHECK:  fir.call @_QPtakes_char_array(%[[VAL_9]]) {{.*}}: (!fir.boxchar<1>) -> ()