blob: 7fb6a886971a786153a90c1e88a2f96900eb509e [file] [log] [blame]
! { dg-do run }
!
! Test the behavior 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])) STOP 1
if (any(id(lbound(arg)) /= [1, 1])) STOP 2
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) lbound(arg)
if (buffer /= ' 1 1') STOP 3
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(lbound(arg))
if (buffer /= ' 1 1') STOP 4
!print *, ubound(arg)
!print *, id(ubound(arg))
if (any(ubound(arg) /= [3, 8])) STOP 5
if (any(id(ubound(arg)) /= [3, 8])) STOP 6
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) ubound(arg)
if (buffer /= ' 3 8') STOP 7
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(ubound(arg))
if (buffer /= ' 3 8') STOP 8
!print *, shape(arg)
!print *, id(shape(arg))
if (any(shape(arg) /= [3, 8])) STOP 9
if (any(id(shape(arg)) /= [3, 8])) STOP 10
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) shape(arg)
if (buffer /= ' 3 8') STOP 11
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(shape(arg))
if (buffer /= ' 3 8') STOP 12
end subroutine foo
subroutine bar(arg)
integer, allocatable :: arg(:,:)
!print *, lbound(arg)
!print *, id(lbound(arg))
if (any(lbound(arg) /= [2, -2])) STOP 13
if (any(id(lbound(arg)) /= [2, -2])) STOP 14
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) lbound(arg)
if (buffer /= ' 2 -2') STOP 15
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(lbound(arg))
if (buffer /= ' 2 -2') STOP 16
!print *, ubound(arg)
!print *, id(ubound(arg))
if (any(ubound(arg) /= [4, 5])) STOP 17
if (any(id(ubound(arg)) /= [4, 5])) STOP 18
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) ubound(arg)
if (buffer /= ' 4 5') STOP 19
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(ubound(arg))
if (buffer /= ' 4 5') STOP 20
!print *, shape(arg)
!print *, id(shape(arg))
if (any(shape(arg) /= [3, 8])) STOP 21
if (any(id(shape(arg)) /= [3, 8])) STOP 22
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) shape(arg)
if (buffer /= ' 3 8') STOP 23
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(shape(arg))
if (buffer /= ' 3 8') STOP 24
end subroutine bar
subroutine baz(arg)
integer, pointer :: arg(..)
!print *, lbound(arg)
!print *, id(lbound(arg))
if (any(lbound(arg) /= [2, -2])) STOP 25
if (any(id(lbound(arg)) /= [2, -2])) STOP 26
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) lbound(arg)
if (buffer /= ' 2 -2') STOP 27
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(lbound(arg))
if (buffer /= ' 2 -2') STOP 28
!print *, ubound(arg)
!print *, id(ubound(arg))
if (any(ubound(arg) /= [4, 5])) STOP 29
if (any(id(ubound(arg)) /= [4, 5])) STOP 30
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) ubound(arg)
if (buffer /= ' 4 5') STOP 31
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(ubound(arg))
if (buffer /= ' 4 5') STOP 32
!print *, shape(arg)
!print *, id(shape(arg))
if (any(shape(arg) /= [3, 8])) STOP 33
if (any(id(shape(arg)) /= [3, 8])) STOP 34
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) shape(arg)
if (buffer /= ' 3 8') STOP 35
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(shape(arg))
if (buffer /= ' 3 8') STOP 36
end subroutine baz
elemental function id(arg)
integer, intent(in) :: arg
integer :: id
id = arg
end function id
end program test