xref: /llvm-project/flang/test/Lower/where-allocatable-assignments.f90 (revision f35f863a88f83332bef9605ef4cfe4f05c066efb)
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 -hlfir=false %s -o - | FileCheck %s
4
5module mtest
6contains
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"}) {
11subroutine 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
83end
84end 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)
94end
95