flang/test/Lower/where-allocatable-assignments.f90

   1 ! Test that WHERE mask clean-up occurs at the right time when the
   2 ! WHERE contains whole allocatable assignments.
   3 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
   4
   5 module mtest
   6 contains
   7
   8 ! CHECK-LABEL: func.func @_QMmtestPfoo(
   9 ! CHECK-SAME:       %[[VAL_0:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "a"},
  10 ! CHECK-SAME:       %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> {fir.bindc_name = "b"}) {
  11 subroutine foo(a, b)
  12   integer :: a(:)
  13   integer, allocatable :: b(:)
  14 ! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
  15 ! CHECK:  %[[VAL_3:.*]] = arith.constant 0 : index
  16 ! CHECK:  %[[VAL_4:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_3]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>, index) -> (index, index, index)
  17           ! WHERE mask temp allocation
  18 ! CHECK:  %[[VAL_9:.*]] = fir.allocmem !fir.array<?x!fir.logical<4>>, %[[VAL_4]]#1 {uniq_name = ".array.expr"}
  19 ! CHECK:  %[[VAL_15:.*]] = fir.do_loop {{.*}} {
  20 !           ! WHERE mask element computation
  21 ! CHECK:  }
  22 ! CHECK:  fir.array_merge_store %{{.*}}, %[[VAL_15]] to %[[VAL_9]] : !fir.array<?x!fir.logical<4>>, !fir.array<?x!fir.logical<4>>, !fir.heap<!fir.array<?x!fir.logical<4>>>
  23
  24           ! First assignment to a whole allocatable (in WHERE)
  25 ! CHECK:  fir.if {{.*}} {
  26 ! CHECK:    fir.if {{.*}} {
  27             ! assignment into new storage (`b` allocated with bad shape)
  28 ! CHECK:      fir.allocmem
  29 ! CHECK:      fir.do_loop {{.*}} {
  30 ! CHECK:        fir.array_coor %[[VAL_9]]
  31 ! CHECK:        fir.if %{{.*}} {
  32                   ! WHERE
  33 ! CHECK:          fir.array_update {{.*}}
  34 ! CHECK:        } else {
  35 ! CHECK:        }
  36 ! CHECK:      }
  37 ! CHECK:    } else {
  38               ! assignment into old storage (`b` allocated with the same shape)
  39 ! CHECK:      fir.do_loop {{.*}} {
  40 ! CHECK:        fir.array_coor %[[VAL_9]]
  41 ! CHECK:        fir.if %{{.*}} {
  42                   ! WHERE
  43 ! CHECK:          fir.array_update {{.*}}
  44 ! CHECK:        } else {
  45 ! CHECK:        }
  46 ! CHECK:      }
  47 ! CHECK:    }
  48 ! CHECK:  } else {
  49             ! assignment into new storage (`b` unallocated)
  50 ! CHECK:    fir.allocmem
  51 ! CHECK:    fir.do_loop %{{.*}} {
  52 ! CHECK:      fir.array_coor %[[VAL_9]]
  53 ! CHECK:      fir.if %{{.*}} {
  54                 ! WHERE
  55 ! CHECK:        fir.array_update {{.*}}
  56 ! CHECK:      } else {
  57 ! CHECK:      }
  58 ! CHECK:    }
  59 ! CHECK:  }
  60 ! CHECK:  fir.if {{.*}} {
  61 ! CHECK:    fir.if {{.*}} {
  62               ! deallocation of `b` old allocatable data store
  63 ! CHECK:    }
  64             ! update of `b` descriptor
  65 ! CHECK:  }
  66           ! Second assignment (in ELSEWHERE)
  67 ! CHECK:  fir.do_loop {{.*}} {
  68 ! CHECK:    fir.array_coor %[[VAL_9]]{{.*}} : (!fir.heap<!fir.array<?x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
  69 ! CHECK:    fir.if {{.*}} {
  70 ! CHECK:    } else {
  71               ! elsewhere
  72 ! CHECK:      fir.array_update
  73 ! CHECK:    }
  74 ! CHECK:  }
  75           ! WHERE temp clean-up
  76 ! CHECK:  fir.freemem %[[VAL_9]] : !fir.heap<!fir.array<?x!fir.logical<4>>>
  77 ! CHECK-NEXT:  return
  78   where (b > 0)
  79     b = a
  80   elsewhere
  81     b(:) = 0
  82   end where
  83 end
  84 end module
  85
  86   use mtest
  87   integer, allocatable :: a(:), b(:)
  88   allocate(a(10),b(10))
  89   a = 5
  90   b = 1
  91   call foo(a, b)
  92   print*, b
  93   deallocate(a,b)
  94 end