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