PR tree-optimization/86415 - strlen() not folded for substrings within constant arrays
[official-gcc.git] / gcc / testsuite / gfortran.dg / bound_9.f90
blob0bceff3334d5385984448d60e37c79b3cde28227
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
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
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
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
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
50 call foo(a,b,n,m)
51 if (n .ne. 1 .or. m .ne. -2) STOP 1
52 call foo(a(2:0), empty, n, m)
53 if (n .ne. 1 .or. m .ne. 1) STOP 2
54 call foo(empty, a(2:0), n, m)
55 if (n .ne. 1 .or. m .ne. 1) STOP 3
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) STOP 4
61 call baz(a,3,2,n)
62 if (n .ne. 1) STOP 5
64 call baz(a,2,3,n)
65 if (n .ne. 2) STOP 6
67 call qux(a, -3, n)
68 if (n .ne. 1) STOP 7
69 end program main
70 ! { dg-final { scan-tree-dump-times "\\*one = 1" 2 "original" } }