gcc/testsuite/gfortran.dg/array_constructor_40.f90

   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
   6 module mymod
   7   implicit none
   8 contains
   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
  31 end module mymod
  32
  33 program 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) call abort
  48   call baz(a,b,res);
  49   if (abs(res - 8.1) > 1e-5) call abort
  50 end program main
  51 ! { dg-final { scan-tree-dump-times "while" 5 "original" } }
  52 ! { dg-final { cleanup-tree-dump "original" } }