gcc/testsuite/gfortran.dg/assumed_rank_bounds_1.f90

! { dg-do run }
!
! Test the behaviour of lbound, ubound of shape with assumed rank arguments
! in an array context (without DIM argument).
!

program test

  integer              :: a(2:4,-2:5)
  integer, allocatable :: b(:,:)
  integer, pointer     :: c(:,:)
  character(52)        :: buffer

  call foo(a)

  allocate(b(2:4,-2:5))
  call foo(b)
  call bar(b)

  allocate(c(2:4,-2:5))
  call foo(c)
  call baz(c)

contains
  subroutine foo(arg)
    integer :: arg(..)

    !print *, lbound(arg)
    !print *, id(lbound(arg))
    if (any(lbound(arg) /= [1, 1])) call abort
    if (any(id(lbound(arg)) /= [1, 1])) call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) lbound(arg)
    if (buffer /= '           1           1') call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) id(lbound(arg))
    if (buffer /= '           1           1') call abort

    !print *, ubound(arg)
    !print *, id(ubound(arg))
    if (any(ubound(arg) /= [3, 8])) call abort
    if (any(id(ubound(arg)) /= [3, 8])) call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) ubound(arg)
    if (buffer /= '           3           8') call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) id(ubound(arg))
    if (buffer /= '           3           8') call abort

    !print *, shape(arg)
    !print *, id(shape(arg))
    if (any(shape(arg) /= [3, 8])) call abort
    if (any(id(shape(arg)) /= [3, 8])) call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) shape(arg)
    if (buffer /= '           3           8') call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) id(shape(arg))
    if (buffer /= '           3           8') call abort

  end subroutine foo
  subroutine bar(arg)
    integer, allocatable :: arg(:,:)

    !print *, lbound(arg)
    !print *, id(lbound(arg))
    if (any(lbound(arg) /= [2, -2])) call abort
    if (any(id(lbound(arg)) /= [2, -2])) call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) lbound(arg)
    if (buffer /= '           2          -2') call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) id(lbound(arg))
    if (buffer /= '           2          -2') call abort

    !print *, ubound(arg)
    !print *, id(ubound(arg))
    if (any(ubound(arg) /= [4, 5])) call abort
    if (any(id(ubound(arg)) /= [4, 5])) call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) ubound(arg)
    if (buffer /= '           4           5') call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) id(ubound(arg))
    if (buffer /= '           4           5') call abort

    !print *, shape(arg)
    !print *, id(shape(arg))
    if (any(shape(arg) /= [3, 8])) call abort
    if (any(id(shape(arg)) /= [3, 8])) call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) shape(arg)
    if (buffer /= '           3           8') call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) id(shape(arg))
    if (buffer /= '           3           8') call abort

  end subroutine bar
  subroutine baz(arg)
    integer, pointer :: arg(..)

    !print *, lbound(arg)
    !print *, id(lbound(arg))
    if (any(lbound(arg) /= [2, -2])) call abort
    if (any(id(lbound(arg)) /= [2, -2])) call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) lbound(arg)
    if (buffer /= '           2          -2') call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) id(lbound(arg))
    if (buffer /= '           2          -2') call abort

    !print *, ubound(arg)
    !print *, id(ubound(arg))
    if (any(ubound(arg) /= [4, 5])) call abort
    if (any(id(ubound(arg)) /= [4, 5])) call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) ubound(arg)
    if (buffer /= '           4           5') call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) id(ubound(arg))
    if (buffer /= '           4           5') call abort

    !print *, shape(arg)
    !print *, id(shape(arg))
    if (any(shape(arg) /= [3, 8])) call abort
    if (any(id(shape(arg)) /= [3, 8])) call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) shape(arg)
    if (buffer /= '           3           8') call abort
    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    write(buffer,*) id(shape(arg))
    if (buffer /= '           3           8') call abort

  end subroutine baz
  elemental function id(arg)
    integer, intent(in) :: arg
    integer             :: id

    id = arg
  end function id
end program test