! { dg-do run } | |
! Test the fix for PR38852 and PR39006 in which LBOUND did not work | |
! for some arrays with negative strides. | |
! | |
! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com> | |
! Clive Page <clivegpage@googlemail.com> | |
! and Mikael Morin <mikael.morin@tele2.fr> | |
! | |
program try_je0031 | |
integer ida(4) | |
real dda(5,5,5,5,5) | |
integer, parameter :: nx = 4, ny = 3 | |
interface | |
SUBROUTINE PR38852(IDA,DDA,nf2,nf5,mf2) | |
INTEGER IDA(4) | |
REAL DDA(5,5,5,5,5) | |
TARGET DDA | |
END SUBROUTINE | |
end interface | |
integer :: array1(nx,ny), array2(nx,ny) | |
data array2 / 1,2,3,4, 10,20,30,40, 100,200,300,400 / | |
array1 = array2 | |
call PR38852(IDA,DDA,2,5,-2) | |
call PR39006(array1, array2(:,ny:1:-1)) | |
call mikael ! http://gcc.gnu.org/ml/fortran/2009-01/msg00342.html | |
contains | |
subroutine PR39006(array1, array2) | |
integer, intent(in) :: array1(:,:), array2(:,:) | |
integer :: j | |
do j = 1, ubound(array2,2) | |
if (any (array1(:,j) .ne. array2(:,4-j))) call abort | |
end do | |
end subroutine | |
end | |
SUBROUTINE PR38852(IDA,DDA,nf2,nf5,mf2) | |
INTEGER IDA(4) | |
REAL DLA(:,:,:,:) | |
REAL DDA(5,5,5,5,5) | |
POINTER DLA | |
TARGET DDA | |
DLA => DDA(2:3, 1:3:2, 5:4:-1, NF2, NF5:NF2:MF2) | |
IDA = UBOUND(DLA) | |
if (any(ida /= 2)) call abort | |
DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2) | |
IDA = UBOUND(DLA) | |
if (any(ida /= 2)) call abort | |
! | |
! These worked. | |
! | |
DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2) | |
IDA = shape(DLA) | |
if (any(ida /= 2)) call abort | |
DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2) | |
IDA = LBOUND(DLA) | |
if (any(ida /= 1)) call abort | |
END SUBROUTINE | |
subroutine mikael | |
implicit none | |
call test (1, 3, 3) | |
call test (2, 3, 3) | |
call test (2, -1, 0) | |
call test (1, -1, 0) | |
contains | |
subroutine test (a, b, expect) | |
integer :: a, b, expect | |
integer :: c(a:b) | |
if (ubound (c, 1) .ne. expect) call abort | |
end subroutine test | |
end subroutine |