flang/test/HLFIR/assumed_shape_with_value_keyword.f90

   1 ! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
   2
   3 ! Addresses assumed shape dummy argument with VALUE keyword
   4
   5 subroutine test_integer_value1(x)
   6   integer, value :: x(:)
   7   call internal_call1(x)
   8 end
   9
  10 ! CHECK-LABEL:  func.func @_QPtest_integer_value1(
  11 ! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "x"}) {
  12 ! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFtest_integer_value1Ex"} : (!fir.box<!fir.array<?xi32>>, !fir.dscope) -> (!fir.box<!fir.array<?xi32>>, !fir.box<!fir.array<?xi32>>)
  13 ! CHECK:          %[[VAL_1:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 to %[[TMP_BOX:.*]] : (!fir.box<!fir.array<?xi32>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> (!fir.box<!fir.array<?xi32>>, i1)
  14 ! CHECK:          %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#0 : (!fir.box<!fir.array<?xi32>>) -> !fir.ref<!fir.array<?xi32>>
  15 ! CHECK:          fir.call @_QPinternal_call1(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?xi32>>) -> ()
  16 ! CHECK:          hlfir.copy_out %[[TMP_BOX]], %[[VAL_1]]#1 to %[[VAL_0]]#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>, i1, !fir.box<!fir.array<?xi32>>) -> ()
  17 ! CHECK:          return
  18 ! CHECK:        }
  19
  20 subroutine test_integer_value2(x)
  21   integer, value :: x(:,:)
  22   call internal_call2(x)
  23 end
  24 ! CHECK-LABEL:  func.func @_QPtest_integer_value2(
  25 ! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?x?xi32>> {fir.bindc_name = "x"}) {
  26 ! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFtest_integer_value2Ex"} : (!fir.box<!fir.array<?x?xi32>>, !fir.dscope) -> (!fir.box<!fir.array<?x?xi32>>, !fir.box<!fir.array<?x?xi32>>)
  27 ! CHECK:          %[[VAL_1:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 to %[[TMP_BOX:.*]] : (!fir.box<!fir.array<?x?xi32>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>) -> (!fir.box<!fir.array<?x?xi32>>, i1)
  28 ! CHECK:          %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#0 : (!fir.box<!fir.array<?x?xi32>>) -> !fir.ref<!fir.array<?x?xi32>>
  29 ! CHECK:          fir.call @_QPinternal_call2(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?x?xi32>>) -> ()
  30 ! CHECK:          hlfir.copy_out %[[TMP_BOX]], %[[VAL_1]]#1 to %[[VAL_0]]#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>, i1, !fir.box<!fir.array<?x?xi32>>) -> ()
  31 ! CHECK:          return
  32 ! CHECK:        }
  33
  34 subroutine test_real_value1(x)
  35   real, value :: x(:)
  36   call internal_call3(x)
  37 end
  38 ! CHECK-LABEL:  func.func @_QPtest_real_value1(
  39 ! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
  40 ! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFtest_real_value1Ex"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
  41 ! CHECK:          %[[VAL_1:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 to %[[TMP_BOX:.*]] : (!fir.box<!fir.array<?xf32>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> (!fir.box<!fir.array<?xf32>>, i1)
  42 ! CHECK:          %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
  43 ! CHECK:          fir.call @_QPinternal_call3(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?xf32>>) -> ()
  44 ! CHECK:          hlfir.copy_out %[[TMP_BOX]], %[[VAL_1]]#1 to %[[VAL_0]]#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>, i1, !fir.box<!fir.array<?xf32>>) -> ()
  45 ! CHECK:          return
  46 ! CHECK:        }
  47
  48 subroutine test_real_value2(x)
  49   real, value :: x(:,:)
  50   call internal_call4(x)
  51 end
  52 ! CHECK-LABEL:  func.func @_QPtest_real_value2(
  53 ! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?x?xf32>> {fir.bindc_name = "x"}) {
  54 ! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFtest_real_value2Ex"} : (!fir.box<!fir.array<?x?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?x?xf32>>, !fir.box<!fir.array<?x?xf32>>)
  55 ! CHECK:          %[[VAL_1:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 to %[[TMP_BOX:.*]] : (!fir.box<!fir.array<?x?xf32>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xf32>>>>) -> (!fir.box<!fir.array<?x?xf32>>, i1)
  56 ! CHECK:          %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#0 : (!fir.box<!fir.array<?x?xf32>>) -> !fir.ref<!fir.array<?x?xf32>>
  57 ! CHECK:          fir.call @_QPinternal_call4(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?x?xf32>>) -> ()
  58 ! CHECK:          hlfir.copy_out %[[TMP_BOX]], %[[VAL_1]]#1 to %[[VAL_0]]#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?xf32>>>>, i1, !fir.box<!fir.array<?x?xf32>>) -> ()
  59 ! CHECK:          return
  60 ! CHECK:        }
  61
  62 subroutine test_complex_value1(x)
  63   complex, value :: x(:)
  64   call internal_call5(x)
  65 end
  66 ! CHECK-LABEL:  func.func @_QPtest_complex_value1(
  67 ! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?xcomplex<f32>>> {fir.bindc_name = "x"}) {
  68 ! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFtest_complex_value1Ex"} : (!fir.box<!fir.array<?xcomplex<f32>>>, !fir.dscope) -> (!fir.box<!fir.array<?xcomplex<f32>>>, !fir.box<!fir.array<?xcomplex<f32>>>)
  69 ! CHECK:          %[[VAL_1:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 to %[[TMP_BOX:.*]] : (!fir.box<!fir.array<?xcomplex<f32>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xcomplex<f32>>>>>) -> (!fir.box<!fir.array<?xcomplex<f32>>>, i1)
  70 ! CHECK:          %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#0 : (!fir.box<!fir.array<?xcomplex<f32>>>) -> !fir.ref<!fir.array<?xcomplex<f32>>>
  71 ! CHECK:          fir.call @_QPinternal_call5(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?xcomplex<f32>>>) -> ()
  72 ! CHECK:          hlfir.copy_out %[[TMP_BOX]], %[[VAL_1]]#1 to %[[VAL_0]]#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xcomplex<f32>>>>>, i1, !fir.box<!fir.array<?xcomplex<f32>>>) -> ()
  73 ! CHECK:          return
  74 ! CHECK:        }
  75
  76 subroutine test_complex_value2(x)
  77   complex, value :: x(:,:)
  78   call internal_call6(x)
  79 end
  80 ! CHECK-LABEL:  func.func @_QPtest_complex_value2(
  81 ! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?x?xcomplex<f32>>> {fir.bindc_name = "x"}) {
  82 ! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFtest_complex_value2Ex"} : (!fir.box<!fir.array<?x?xcomplex<f32>>>, !fir.dscope) -> (!fir.box<!fir.array<?x?xcomplex<f32>>>, !fir.box<!fir.array<?x?xcomplex<f32>>>)
  83 ! CHECK:          %[[VAL_1:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 to %[[TMP_BOX:.*]] : (!fir.box<!fir.array<?x?xcomplex<f32>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xcomplex<f32>>>>>) -> (!fir.box<!fir.array<?x?xcomplex<f32>>>, i1)
  84 ! CHECK:          %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#0 : (!fir.box<!fir.array<?x?xcomplex<f32>>>) -> !fir.ref<!fir.array<?x?xcomplex<f32>>>
  85 ! CHECK:          fir.call @_QPinternal_call6(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?x?xcomplex<f32>>>) -> ()
  86 ! CHECK:          hlfir.copy_out %[[TMP_BOX]], %[[VAL_1]]#1 to %[[VAL_0]]#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?xcomplex<f32>>>>>, i1, !fir.box<!fir.array<?x?xcomplex<f32>>>) -> ()
  87 ! CHECK:          return
  88 ! CHECK:        }
  89
  90 subroutine test_optional1(x)
  91   real, value, optional :: x(:)
  92   if (present(x)) then
  93     call internal_call7(x)
  94   endif
  95 end
  96 ! CHECK-LABEL:  func.func @_QPtest_optional1(
  97 ! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
  98 ! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<optional, value>, uniq_name = "_QFtest_optional1Ex"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
  99 ! CHECK:          %[[VAL_1:.*]] = fir.is_present %[[VAL_0]]#1 : (!fir.box<!fir.array<?xf32>>) -> i1
 100 ! CHECK:          fir.if %[[VAL_1:.*]] {
 101 ! CHECK:            %[[VAL_2:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 to %[[TMP_BOX:.*]] : (!fir.box<!fir.array<?xf32>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> (!fir.box<!fir.array<?xf32>>, i1)
 102 ! CHECK:            %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]]#0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
 103 ! CHECK:            fir.call @_QPinternal_call7(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.array<?xf32>>) -> ()
 104 ! CHECK:            hlfir.copy_out %[[TMP_BOX]], %[[VAL_2]]#1 to %[[VAL_0]]#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>, i1, !fir.box<!fir.array<?xf32>>) -> ()
 105 ! CHECK:          }
 106 ! CHECK:          return
 107 ! CHECK:        }
 108
 109 subroutine test_optional2(x)
 110   real, value, optional :: x(:,:)
 111   if (present(x)) then
 112     call internal_call8(x)
 113   endif
 114 end
 115 ! CHECK-LABEL:  func.func @_QPtest_optional2(
 116 ! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?x?xf32>> {fir.bindc_name = "x", fir.optional}) {
 117 ! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<optional, value>, uniq_name = "_QFtest_optional2Ex"} : (!fir.box<!fir.array<?x?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?x?xf32>>, !fir.box<!fir.array<?x?xf32>>)
 118 ! CHECK:          %[[VAL_1:.*]] = fir.is_present %[[VAL_0]]#1 : (!fir.box<!fir.array<?x?xf32>>) -> i1
 119 ! CHECK:          fir.if %[[VAL_1:.*]] {
 120 ! CHECK:            %[[VAL_2:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 to %[[TMP_BOX:.*]] : (!fir.box<!fir.array<?x?xf32>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xf32>>>>) -> (!fir.box<!fir.array<?x?xf32>>, i1)
 121 ! CHECK:            %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]]#0 : (!fir.box<!fir.array<?x?xf32>>) -> !fir.ref<!fir.array<?x?xf32>>
 122 ! CHECK:            fir.call @_QPinternal_call8(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.array<?x?xf32>>) -> ()
 123 ! CHECK:            hlfir.copy_out %[[TMP_BOX]], %[[VAL_2]]#1 to %[[VAL_0]]#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?xf32>>>>, i1, !fir.box<!fir.array<?x?xf32>>) -> ()
 124 ! CHECK:          }
 125 ! CHECK:          return
 126 ! CHECK:        }
 127
 128 subroutine test_optional3(x)
 129   real, value, optional :: x(:)
 130   if (present(x)) then
 131     stop
 132   endif
 133 end
 134 ! CHECK-LABEL:  func.func @_QPtest_optional3(
 135 ! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
 136 ! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<optional, value>, uniq_name = "_QFtest_optional3Ex"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
 137 ! CHECK:          %[[VAL_1:.*]] = fir.is_present %[[VAL_0]]#1 : (!fir.box<!fir.array<?xf32>>) -> i1
 138 ! CHECK:          cf.cond_br %[[VAL_1]], ^bb1, ^bb2
 139 ! CHECK:          b1:  // pred: ^bb0
 140 ! CHECK:          %[[C0_I32:.*]] = arith.constant 0 : i32
 141 ! CHECK:          %[[FALSE:.*]] = arith.constant false
 142 ! CHECK:          %[[FALSE_0:.*]] = arith.constant false
 143 ! CHECK:          %[[VAL_2:.*]] = fir.call @_FortranAStopStatement(%[[C0_I32]], %[[FALSE]], %[[FALSE]]_0) fastmath<contract> : (i32, i1, i1) -> none
 144 ! CHECK:          fir.unreachable
 145 ! CHECK:          b2:  // pred: ^bb0
 146 ! CHECK:          return
 147 ! CHECK:        }