flang/test/Lower/HLFIR/transpose.f90

   1 ! Test lowering of TRANSPOSE intrinsic to HLFIR
   2 ! RUN: bbc -emit-hlfir --polymorphic-type -o - %s 2>&1 | FileCheck %s
   3
   4 subroutine transpose1(m, res)
   5   integer :: m(1,2), res(2, 1)
   6   res = TRANSPOSE(m)
   7 endsubroutine
   8 ! CHECK-LABEL: func.func @_QPtranspose1
   9 ! CHECK:           %[[M_ARG:.*]]: !fir.ref<!fir.array<1x2xi32>>
  10 ! CHECK:           %[[RES_ARG:.*]]: !fir.ref<!fir.array<2x1xi32>>
  11 ! CHECK-DAG:     %[[ARG:.*]]:2 = hlfir.declare %[[M_ARG]](%[[M_SHAPE:.*]]) {[[NAME:.*]]} : (!fir.ref<!fir.array<1x2xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<1x2xi32>>, !fir.ref<!fir.array<1x2xi32>>)
  12 ! CHECK-DAG:     %[[RES:.*]]:2 = hlfir.declare %[[RES_ARG]](%[[RES_SHAPE:.*]]) {[[NAME2:.*]]} : (!fir.ref<!fir.array<2x1xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<2x1xi32>>, !fir.ref<!fir.array<2x1xi32>>)
  13 ! CHECK:         %[[EXPR:.*]] = hlfir.transpose %[[ARG]]#0 : (!fir.ref<!fir.array<1x2xi32>>) -> !hlfir.expr<2x1xi32>
  14 ! CHECK-NEXT:    hlfir.assign %[[EXPR]] to %[[RES]]#0
  15 ! CHECK-NEXT:    hlfir.destroy %[[EXPR]]
  16 ! CHECK-NEXT:    return
  17 ! CHECK-NEXT:  }
  18
  19 ! test the case where lowering has more exact information about the output
  20 ! shape than is available from the argument
  21 subroutine transpose2(a, out)
  22   real, allocatable, dimension(:) :: a
  23   real, dimension(:,:) :: out
  24   integer, parameter :: N = 3
  25   integer, parameter :: M = 4
  26
  27   allocate(a(N*M))
  28   out = transpose(reshape(a, (/N, M/)))
  29 end subroutine
  30 ! CHECK-LABEL: func.func @_QPtranspose2(
  31
  32 subroutine transpose3(m, res)
  33   integer, allocatable :: m(:,:)
  34   integer :: res(2, 1)
  35   res = TRANSPOSE(m)
  36 endsubroutine
  37 ! CHECK-LABEL: func.func @_QPtranspose3
  38 ! CHECK:           %[[M_ARG:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>
  39 ! CHECK:           %[[RES_ARG:.*]]: !fir.ref<!fir.array<2x1xi32>>
  40 ! CHECK-DAG:     %[[ARG:.*]]:2 = hlfir.declare %[[M_ARG]]
  41 ! CHECK-DAG:     %[[RES:.*]]:2 = hlfir.declare %[[RES_ARG]](%[[RES_SHAPE:.*]]) {[[NAME2:.*]]} : (!fir.ref<!fir.array<2x1xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<2x1xi32>>, !fir.ref<!fir.array<2x1xi32>>)
  42 ! CHECK:         %[[ARG_LOADED:.*]] = fir.load %[[ARG]]#0
  43 ! CHECK:         %[[EXPR:.*]] = hlfir.transpose %[[ARG_LOADED]] : (!fir.box<!fir.heap<!fir.array<?x?xi32>>>) -> !hlfir.expr<?x?xi32>
  44 ! CHECK-NEXT:    hlfir.assign %[[EXPR]] to %[[RES]]#0
  45 ! CHECK-NEXT:    hlfir.destroy %[[EXPR]]
  46 ! CHECK-NEXT:    return
  47 ! CHECK-NEXT:  }
  48
  49 ! Test that the result type is polymorphic.
  50 subroutine test_polymorphic_result(m, res)
  51   class(*), allocatable, dimension(:, :) :: m, res
  52   res = transpose(m)
  53 end subroutine test_polymorphic_result
  54 ! CHECK-LABEL:   func.func @_QPtest_polymorphic_result(
  55 ! CHECK-SAME:        %[[VAL_0:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>> {fir.bindc_name = "m"},
  56 ! CHECK-SAME:        %[[VAL_1:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>> {fir.bindc_name = "res"}) {
  57 ! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest_polymorphic_resultEm"} : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>>)
  58 ! CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest_polymorphic_resultEres"} : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>>)
  59 ! CHECK:           %[[VAL_4:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>>
  60 ! CHECK:           %[[VAL_5:.*]] = hlfir.transpose %[[VAL_4]] : (!fir.class<!fir.heap<!fir.array<?x?xnone>>>) -> !hlfir.expr<?x?xnone?>
  61 ! CHECK:           hlfir.assign %[[VAL_5]] to %[[VAL_3]]#0 realloc : !hlfir.expr<?x?xnone?>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>>
  62 ! CHECK:           hlfir.destroy %[[VAL_5]] : !hlfir.expr<?x?xnone?>
  63 ! CHECK:           return
  64 ! CHECK:         }
  65
  66 ! Test that hlfir.transpose lowering inherits constant
  67 ! character length from the argument, when the length
  68 ! is uknown from the Fortran::evaluate expression type.
  69 subroutine test_unknown_char_len_result
  70   character(len=3), dimension(3,3) :: w
  71   character(len=2), dimension(3,3) :: w2
  72   w2 = transpose(w(:,:)(1:2))
  73 end subroutine test_unknown_char_len_result
  74 ! CHECK-LABEL:   func.func @_QPtest_unknown_char_len_result() {
  75 ! CHECK:           %[[VAL_0:.*]] = arith.constant 3 : index
  76 ! CHECK:           %[[VAL_1:.*]] = arith.constant 3 : index
  77 ! CHECK:           %[[VAL_2:.*]] = arith.constant 3 : index
  78 ! CHECK:           %[[VAL_3:.*]] = fir.alloca !fir.array<3x3x!fir.char<1,3>> {bindc_name = "w", uniq_name = "_QFtest_unknown_char_len_resultEw"}
  79 ! CHECK:           %[[VAL_4:.*]] = fir.shape %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shape<2>
  80 ! CHECK:           %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_4]]) typeparams %[[VAL_0]] {uniq_name = "_QFtest_unknown_char_len_resultEw"} : (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>, !fir.shape<2>, index) -> (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>, !fir.ref<!fir.array<3x3x!fir.char<1,3>>>)
  81 ! CHECK:           %[[VAL_6:.*]] = arith.constant 2 : index
  82 ! CHECK:           %[[VAL_7:.*]] = arith.constant 3 : index
  83 ! CHECK:           %[[VAL_8:.*]] = arith.constant 3 : index
  84 ! CHECK:           %[[VAL_9:.*]] = fir.alloca !fir.array<3x3x!fir.char<1,2>> {bindc_name = "w2", uniq_name = "_QFtest_unknown_char_len_resultEw2"}
  85 ! CHECK:           %[[VAL_10:.*]] = fir.shape %[[VAL_7]], %[[VAL_8]] : (index, index) -> !fir.shape<2>
  86 ! CHECK:           %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_9]](%[[VAL_10]]) typeparams %[[VAL_6]] {uniq_name = "_QFtest_unknown_char_len_resultEw2"} : (!fir.ref<!fir.array<3x3x!fir.char<1,2>>>, !fir.shape<2>, index) -> (!fir.ref<!fir.array<3x3x!fir.char<1,2>>>, !fir.ref<!fir.array<3x3x!fir.char<1,2>>>)
  87 ! CHECK:           %[[VAL_12:.*]] = arith.constant 1 : index
  88 ! CHECK:           %[[VAL_13:.*]] = arith.constant 1 : index
  89 ! CHECK:           %[[VAL_14:.*]] = arith.constant 3 : index
  90 ! CHECK:           %[[VAL_15:.*]] = arith.constant 1 : index
  91 ! CHECK:           %[[VAL_16:.*]] = arith.constant 3 : index
  92 ! CHECK:           %[[VAL_17:.*]] = fir.shape %[[VAL_14]], %[[VAL_16]] : (index, index) -> !fir.shape<2>
  93 ! CHECK:           %[[VAL_18:.*]] = arith.constant 1 : index
  94 ! CHECK:           %[[VAL_19:.*]] = arith.constant 2 : index
  95 ! CHECK:           %[[VAL_20:.*]] = arith.constant 2 : index
  96 ! CHECK:           %[[VAL_21:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_12]]:%[[VAL_1]]:%[[VAL_13]], %[[VAL_12]]:%[[VAL_2]]:%[[VAL_15]]) substr %[[VAL_18]], %[[VAL_19]]  shape %[[VAL_17]] typeparams %[[VAL_20]] : (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>, index, index, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.box<!fir.array<3x3x!fir.char<1,2>>>
  97 ! CHECK:           %[[VAL_22:.*]] = hlfir.transpose %[[VAL_21]] : (!fir.box<!fir.array<3x3x!fir.char<1,2>>>) -> !hlfir.expr<3x3x!fir.char<1,2>>
  98 ! CHECK:           hlfir.assign %[[VAL_22]] to %[[VAL_11]]#0 : !hlfir.expr<3x3x!fir.char<1,2>>, !fir.ref<!fir.array<3x3x!fir.char<1,2>>>
  99 ! CHECK:           hlfir.destroy %[[VAL_22]] : !hlfir.expr<3x3x!fir.char<1,2>>
 100 ! CHECK:           return
 101 ! CHECK:         }