1! { dg-do run }
2! Test the fix for PR38852 and PR39006 in which LBOUND did not work
3! for some arrays with negative strides.
4!
5! Contributed by Dick Hendrickson  <dick.hendrickson@gmail.com>
6!                Clive Page        <clivegpage@googlemail.com>
7!            and Mikael Morin      <mikael.morin@tele2.fr>
8!
9program try_je0031
10  integer ida(4)
11  real dda(5,5,5,5,5)
12  integer, parameter :: nx = 4, ny = 3
13  interface
14    SUBROUTINE PR38852(IDA,DDA,nf2,nf5,mf2)
15      INTEGER IDA(4)
16      REAL DDA(5,5,5,5,5)
17      TARGET DDA
18    END SUBROUTINE
19  end interface
20  integer :: array1(nx,ny), array2(nx,ny)
21  data array2 / 1,2,3,4, 10,20,30,40, 100,200,300,400 /
22  array1 = array2
23  call PR38852(IDA,DDA,2,5,-2)
24  call PR39006(array1, array2(:,ny:1:-1))
25  call mikael         ! http://gcc.gnu.org/ml/fortran/2009-01/msg00342.html
26contains
27  subroutine PR39006(array1, array2)
28    integer, intent(in) :: array1(:,:), array2(:,:)
29    integer :: j
30    do j = 1, ubound(array2,2)
31      if (any (array1(:,j) .ne. array2(:,4-j))) STOP 1
32    end do
33  end subroutine
34end
35
36SUBROUTINE PR38852(IDA,DDA,nf2,nf5,mf2)
37  INTEGER IDA(4)
38  REAL DLA(:,:,:,:)
39  REAL DDA(5,5,5,5,5)
40  POINTER DLA
41  TARGET DDA
42  DLA => DDA(2:3, 1:3:2, 5:4:-1, NF2, NF5:NF2:MF2)
43  IDA = UBOUND(DLA)
44  if (any(ida /= 2)) STOP 1
45  DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)
46  IDA = UBOUND(DLA)
47  if (any(ida /= 2)) STOP 1
48!
49! These worked.
50!
51  DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)
52  IDA = shape(DLA)
53  if (any(ida /= 2)) STOP 1
54  DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)
55  IDA = LBOUND(DLA)
56  if (any(ida /= 1)) STOP 1
57END SUBROUTINE
58
59subroutine mikael
60  implicit none
61  call test (1,  3, 3)
62  call test (2,  3, 3)
63  call test (2, -1, 0)
64  call test (1, -1, 0)
65contains
66  subroutine test (a, b, expect)
67    integer :: a, b, expect
68    integer :: c(a:b)
69    if (ubound (c, 1) .ne. expect) STOP 1
70  end subroutine test
71end subroutine
72