1! { dg-do run }
2! { dg-options "-ffrontend-optimize -fdump-tree-original" }
3! PR 55806 - replace ANY intrinsic for array
4! constructor with .or.
5
6module mymod
7  implicit none
8contains
9  subroutine bar(a,b,c, lo)
10    real, dimension(3,3), intent(in) :: a,b
11    logical, dimension(3,3), intent(in) :: lo
12    integer, intent(out) :: c
13    real, parameter :: acc = 1e-4
14    integer :: i,j
15
16    c = 0
17    do i=1,3
18       if (any([abs(a(i,1) - b(i,1)) > acc,  &
19            (j==i+1,j=3,8)])) cycle
20       if (any([abs(a(i,2) - b(i,2)) > acc, &
21            abs(a(i,3) - b(i,3)) > acc, lo(i,:)])) cycle
22       c = c + i
23    end do
24  end subroutine bar
25
26  subroutine baz(a, b, c)
27    real, dimension(3,3), intent(in) :: a,b
28    real, intent(out) :: c
29    c = sum([a(1,1),a(2,2),a(3,3),b(:,1)])
30  end subroutine baz
31end module mymod
32
33program main
34  use mymod
35  implicit none
36  real, dimension(3,3) :: a,b
37  real :: res
38  integer :: c
39  logical lo(3,3)
40  data a/1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9/
41
42  b = a
43  b(2,2) = a(2,2) + 0.2
44  lo = .false.
45  lo(3,3) = .true.
46  call bar(a,b,c,lo)
47  if (c /= 1) STOP 1
48  call baz(a,b,res);
49  if (abs(res - 8.1) > 1e-5) STOP 2
50end program main
51! { dg-final { scan-tree-dump-times "while" 5 "original" } }
52