Subversion Repositories openrisc

! { 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  

!                Clive Page        

!            and Mikael Morin      

!

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