1! { dg-do run }
2!
3! Verify that the bounds are correctly set when assigning pointers.
4!
5! PR fortran/33139
6!
7program prog
8  implicit none
9  real, target :: a(-10:10)
10  real, pointer :: p(:),p2(:)
11  integer :: i
12  do i = -10, 10
13    a(i) = real(i)
14  end do
15  p  => a
16  p2 => p
17  if((lbound(p, dim=1) /= -10) .or. (ubound(p, dim=1) /= 10)) &
18    call abort()
19  if((lbound(p2,dim=1) /= -10) .or. (ubound(p2,dim=1) /= 10)) &
20    call abort()
21  do i = -10, 10
22    if(p(i) /= real(i)) call abort()
23    if(p2(i) /= real(i)) call abort()
24  end do
25  p => a(:)
26  p2 => p
27  if((lbound(p, dim=1) /= 1) .or. (ubound(p, dim=1) /= 21)) &
28    call abort()
29  if((lbound(p2,dim=1) /= 1) .or. (ubound(p2,dim=1) /= 21)) &
30    call abort()
31  p2 => p(:)
32  if((lbound(p2,dim=1) /= 1) .or. (ubound(p2,dim=1) /= 21)) &
33    call abort()
34  call multdim()
35contains
36  subroutine multdim()
37    real, target, allocatable :: b(:,:,:)
38    real, pointer :: ptr(:,:,:)
39    integer :: i, j, k
40    allocate(b(-5:5,10:20,0:3))
41    do i = 0, 3
42      do j = 10, 20
43        do k = -5, 5
44          b(k,j,i) = real(i+10*j+100*k)
45        end do
46      end do
47    end do
48    ptr => b
49    if((lbound(ptr,dim=1) /= -5) .or. (ubound(ptr,dim=1) /=  5) .or. &
50       (lbound(ptr,dim=2) /= 10) .or. (ubound(ptr,dim=2) /= 20) .or. &
51       (lbound(ptr,dim=3) /=  0) .or. (ubound(ptr,dim=3) /=  3))     &
52      call abort()
53    do i = 0, 3
54      do j = 10, 20
55        do k = -5, 5
56          if(ptr(k,j,i) /= real(i+10*j+100*k)) call abort()
57        end do
58      end do
59    end do
60    ptr => b(:,:,:)
61    if((lbound(ptr,dim=1) /= 1) .or. (ubound(ptr,dim=1) /= 11) .or. &
62       (lbound(ptr,dim=2) /= 1) .or. (ubound(ptr,dim=2) /= 11) .or. &
63       (lbound(ptr,dim=3) /= 1) .or. (ubound(ptr,dim=3) /=  4))     &
64      call abort()
65  end subroutine multdim
66end program prog
67