gcc/testsuite/gfortran.dg/bounds_check_8.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fbounds-check" }
   3 ! PR fortran/32036
   4 program test
   5   type t
   6     integer, dimension (5) :: field
   7   end type t
   8   type (t), dimension (2) :: a
   9   integer :: calls
  10
  11   type xyz_type
  12      integer :: x
  13   end type xyz_type
  14   type (xyz_type), dimension(3) :: xyz
  15   character(len=20) :: s
  16
  17   xyz(1)%x = 11111
  18   xyz(2)%x = 0
  19   xyz(3)%x = 0
  20
  21   write(s,*) xyz(bar())
  22   if (trim(adjustl(s)) /= "11111") call abort
  23
  24   a(1)%field = 0
  25   a(2)%field = 0
  26   calls = 0
  27   if (sum(a(foo(calls))%field) /= 0) call abort
  28   if (calls .ne. 1) call abort
  29
  30 contains
  31
  32   function foo (calls)
  33     integer :: calls, foo
  34     calls = calls + 1
  35     foo = 2
  36   end function foo
  37
  38   integer function bar ()
  39     integer, save :: i = 1
  40     bar = i
  41     i = i + 1
  42   end function
  43
  44 end program test