gcc/testsuite/gfortran.dg/bound_9.f90

   1 ! { dg-do  run }
   2 ! { dg-options "-fdump-tree-original" }
   3 ! Check for different combinations of lbound for dummy arrays,
   4 ! stressing empty arrays.  The assignments with "one =" should
   5 ! be simplified at compile time.
   6 module tst
   7   implicit none
   8 contains
   9   subroutine foo (a, b, one, m)
  10     integer, dimension(:), intent(in) :: a
  11     integer, dimension (-2:), intent(in) :: b
  12     integer, intent(out) :: one, m
  13     one = lbound(a,1)
  14     m = lbound(b,1)
  15   end subroutine foo
  16
  17   subroutine bar (a, b, n, m)
  18     integer, dimension(:), allocatable, intent(inout) :: a
  19     integer, dimension(:), pointer, intent(inout) :: b
  20     integer, intent(out) :: n, m
  21     n = lbound(a,1)
  22     m = lbound(b,1)
  23   end subroutine bar
  24
  25   subroutine baz (a, n, m, s)
  26     integer, intent(in) :: n,m
  27     integer, intent(out) :: s
  28     integer, dimension(n:m) :: a
  29     s = lbound(a,1)
  30   end subroutine baz
  31
  32   subroutine qux (a, s, one)
  33     integer, intent(in) :: s
  34     integer, dimension(s) :: a
  35     integer, intent(out) :: one
  36     one = lbound(a,1)
  37   end subroutine qux
  38 end module tst
  39
  40 program main
  41   use tst
  42   implicit none
  43   integer, dimension(3), target :: a, b
  44   integer, dimension(0) :: empty
  45   integer, dimension(:), allocatable :: x
  46   integer, dimension(:), pointer :: y
  47   integer :: n,m
  48
  49
  50   call foo(a,b,n,m)
  51   if (n .ne. 1 .or. m .ne. -2) call abort
  52   call foo(a(2:0), empty, n, m)
  53   if (n .ne. 1 .or. m .ne. 1) call abort
  54   call foo(empty, a(2:0), n, m)
  55   if (n .ne. 1 .or. m .ne. 1) call abort
  56   allocate (x(0))
  57   y => a(3:2)
  58   call bar (x, y, n, m)
  59   if (n .ne. 1 .or. m .ne. 1) call abort
  60
  61   call baz(a,3,2,n)
  62   if (n .ne. 1) call abort
  63
  64   call baz(a,2,3,n)
  65   if (n .ne. 2) call abort
  66
  67   call qux(a, -3, n)
  68   if (n .ne. 1) call abort
  69 end program main
  70 ! { dg-final { scan-tree-dump-times "\\*one = 1" 2 "original" } }