gcc/testsuite/gfortran.dg/array_section_1.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fbounds-check" }
   3 ! Tests the fix for PR30003, in which the 'end' of an array section
   4 ! would not be evaluated at all if it was on the lhs of an assignment
   5 ! or would be evaluated many times if bound checking were on.
   6 !
   7 ! Contributed by Erik Edelmann <eedelmann@gcc.gnu.org>
   8 !
   9     implicit none
  10     integer :: a(5), b(3), cnt
  11
  12     b = [ 1, 2, 3 ]
  13 ! Check the lhs references
  14     cnt = 0
  15     a(bar(1):3) = b
  16     if (cnt /= 1) call abort ()
  17     cnt = 0
  18     a(1:bar(3)) = b
  19     if (cnt /= 1) call abort ()
  20     cnt = 0
  21     a(1:3:bar(1)) = b
  22     if (cnt /= 1) call abort ()
  23 ! Check the rhs references
  24     cnt = 0
  25     a(1:3) = b(bar(1):3)
  26     if (cnt /= 1) call abort ()
  27     cnt = 0
  28     a(1:3) = b(1:bar(3))
  29     if (cnt /= 1) call abort ()
  30     cnt = 0
  31     a(1:3) = b(1:3:bar(1))
  32     if (cnt /= 1) call abort ()
  33 contains
  34     integer function bar(n)
  35         integer, intent(in) :: n
  36         cnt = cnt + 1
  37         bar = n
  38     end function bar
  39 end