gcc/testsuite/gfortran.dg/pointer_assign_4.f90

   1 ! { dg-do run }
   2 !
   3 ! Verify that the bounds are correctly set when assigning pointers.
   4 !
   5 ! PR fortran/33139
   6 !
   7 program 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     STOP 1
  19   if((lbound(p2,dim=1) /= -10) .or. (ubound(p2,dim=1) /= 10)) &
  20     STOP 2
  21   do i = -10, 10
  22     if(p(i) /= real(i)) STOP 3
  23     if(p2(i) /= real(i)) STOP 4
  24   end do
  25   p => a(:)
  26   p2 => p
  27   if((lbound(p, dim=1) /= 1) .or. (ubound(p, dim=1) /= 21)) &
  28     STOP 5
  29   if((lbound(p2,dim=1) /= 1) .or. (ubound(p2,dim=1) /= 21)) &
  30     STOP 6
  31   p2 => p(:)
  32   if((lbound(p2,dim=1) /= 1) .or. (ubound(p2,dim=1) /= 21)) &
  33     STOP 7
  34   call multdim()
  35 contains
  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       STOP 8
  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)) STOP 9
  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       STOP 10
  65   end subroutine multdim
  66 end program prog