gcc/testsuite/gfortran.dg/PR85868B.f90

   1 program main_p
   2
   3   implicit none
   4
   5   integer, parameter :: n = 10
   6   integer, parameter :: m = 5
   7
   8   integer, parameter :: b = 3
   9   integer, parameter :: t = n+b-1
  10
  11   integer, parameter :: l = 4
  12   integer, parameter :: u = 7
  13   integer, parameter :: s = 3
  14   integer, parameter :: e = (u-l)/s+1
  15
  16   call test_f()
  17   call test_s()
  18   call test_p()
  19   call test_a()
  20   stop
  21
  22 contains
  23
  24   subroutine test_f()
  25     integer, target :: x(n,n)
  26     integer, target :: y(b:t)
  27     integer         :: i
  28
  29     x = reshape([(i, i=1,n*n)], [n,n])
  30     y = x(:,m)
  31     call sub_s(x(:,m), y, 1, n, n)
  32     call sub_s(y, x(:,m), b, t, n)
  33     return
  34   end subroutine test_f
  35
  36   subroutine test_s()
  37     integer, target :: x(n,n)
  38     integer, target :: v(e)
  39     integer         :: i
  40
  41     x = reshape([(i, i=1,n*n)], [n,n])
  42     v = x(l:u:s,m)
  43     call sub_s(v, v, 1, e, e)
  44     call sub_s(x(l:u:s,m), v, 1, e, e)
  45     call sub_s(v, x(l:u:s,m), 1, e, e)
  46     return
  47   end subroutine test_s
  48
  49   subroutine test_p()
  50     integer,  target :: x(n,n)
  51     integer, pointer :: p(:)
  52     integer          :: v(e)
  53     integer          :: i
  54
  55     x = reshape([(i, i=1,n*n)], [n,n])
  56     v = x(l:u:s,m)
  57     p => x(:,m)
  58     call sub_s(p(l:u:s), v, 1, e, e)
  59     p => x(l:u:s,m)
  60     call sub_s(p, v, 1, e, e)
  61     p(l:) => x(l:u:s,m)
  62     call sub_s(p, v, l, e+l-1, e)
  63     p(l:l+e-1) => x(l:u:s,m)
  64     call sub_s(p, v, l, e+l-1, e)
  65     allocate(p(n))
  66     p(:) = x(:,m)
  67     call sub_s(p(l:u:s), v, 1, e, e)
  68     deallocate(p)
  69     allocate(p(e))
  70     p(:) = x(l:u:s,m)
  71     call sub_s(p, v, 1, e, e)
  72     deallocate(p)
  73     allocate(p(l:l+e-1))
  74     p(:) = x(l:u:s,m)
  75     call sub_s(p, v, l, e+l-1, e)
  76     deallocate(p)
  77     allocate(p(l:l+e-1))
  78     p(l:) = x(l:u:s,m)
  79     call sub_s(p, v, l, e+l-1, e)
  80     deallocate(p)
  81     allocate(p(l:l+e-1))
  82     p(l:l+e-1) = x(l:u:s,m)
  83     call sub_s(p, v, l, e+l-1, e)
  84     deallocate(p)
  85     return
  86   end subroutine test_p
  87
  88   subroutine test_a()
  89     integer                      :: x(n,n)
  90     integer, allocatable, target :: a(:)
  91     integer                      :: v(e)
  92     integer                      :: i
  93
  94     x = reshape([(i, i=1,n*n)], [n,n])
  95     v = x(l:u:s,m)
  96     a = x(:,m)
  97     call sub_s(a(l:u:s), v, 1, e, e)
  98     deallocate(a)
  99     allocate(a(n))
 100     a(:) = x(:,m)
 101     call sub_s(a(l:u:s), v, 1, e, e)
 102     deallocate(a)
 103     a = x(l:u:s,m)
 104     call sub_s(a, v, 1, e, e)
 105     deallocate(a)
 106     allocate(a(e))
 107     a(:) = x(l:u:s,m)
 108     call sub_s(a, v, 1, e, e)
 109     deallocate(a)
 110     allocate(a(l:l+e-1))
 111     a(:) = x(l:u:s,m)
 112     call sub_s(a, v, l, e+l-1, e)
 113     deallocate(a)
 114     allocate(a(l:l+e-1))
 115     a(l:) = x(l:u:s,m)
 116     call sub_s(a, v, l, e+l-1, e)
 117     deallocate(a)
 118     allocate(a(l:l+e-1))
 119     a(l:l+e-1) = x(l:u:s,m)
 120     call sub_s(a, v, l, e+l-1, e)
 121     deallocate(a)
 122     return
 123   end subroutine test_a
 124
 125   subroutine  sub_s(a, b, l, u, e)
 126     integer, pointer, intent(in) :: a(:)
 127     integer,          intent(in) :: b(:)
 128     integer,          intent(in) :: l
 129     integer,          intent(in) :: u
 130     integer,          intent(in) :: e
 131
 132     integer :: i
 133
 134     if(lbound(a,dim=1)/=l) stop 1001
 135     if(ubound(a,dim=1)/=u) stop 1002
 136     if(any(shape(a)/=[e])) stop 1003
 137     if(size(a, dim=1)/=e)  stop 1004
 138     if(size(a)/=size(b))   stop 1005
 139     do i = l, u
 140       if(a(i)/=b(i-l+1)) stop 1006
 141     end do
 142   end subroutine sub_s
 143
 144 end program main_p