1! { dg-do run }
2! { dg-options "-O2 -fdump-tree-original" }
3
4module foo
5contains
6  subroutine bar(a)
7    real, dimension(:,:) :: a
8    a(1,:) = 0.
9  end subroutine bar
10end module foo
11
12program test
13  use foo
14  implicit none
15  real, dimension (2,2) :: a, d, e
16  real, dimension (1,2) :: b
17  real, dimension (2) :: c
18  data a, d, e /12*1.0/
19  data b /2*1.0/
20  data c /2*1.0/
21
22  a(1,:) = 0.    ! This can't be optimized to a memset.
23  b(1,:) = 0.    ! This is optimized to = {}.
24  c = 0.         ! This is optimized to = {}.
25  d(:,1) = 0.    ! This can't be otimized to a memset.
26  call bar(e)
27
28  if (any(a /= reshape((/ 0.0, 1.0, 0.0, 1.0/), shape(a)))) call abort
29  if (any(b /= 0.)) call abort
30  if (any(c /= 0.)) call abort
31  if (any(d /= reshape((/ 0.0, 0.0, 1.0, 1.0/), shape(d)))) call abort
32  if (any(e /= reshape((/ 0.0, 1.0, 0.0, 1.0/), shape(e)))) call abort
33
34end program
35
36! { dg-final { scan-tree-dump-times "= {}" 2 "original" } }
37! { dg-final { cleanup-tree-dump "original" } }
38