! { dg-do run }
!
! TS 29113
! 7.2 RANK (A)
! Description. Rank of a data object.
! Class. Inquiry function.
! Argument.
! A shall be a scalar or array of any type.
! Result Characteristics. Default integer scalar.
! Result Value. The result is the rank of A.

program test 

  ! Define some arrays for testing.
  integer, target :: x1(5)
  integer :: y1(0:9)
  integer, pointer :: p1(:)
  integer, allocatable :: a1(:)
  integer, target :: x3(2,3,4)
  integer :: y3(0:1,-3:-1,4)
  integer, pointer :: p3(:,:,:)
  integer, allocatable :: a3(:,:,:)
  integer :: x

  ! Test the 1-dimensional arrays.
  if (rank (x1) .ne. 1) stop 201
  call testit (x1, 1)
  call test1 (x1)
  if (rank (y1) .ne. 1) stop 202
  call testit (y1, 1)
  call test1 (y1)
  if (rank (p1) .ne. 1) stop 203
  p1 => x1
  call testit (p1, 1)
  if (rank (p1) .ne. 1) stop 204
  call test1 (p1)
  if (rank (a1) .ne. 1) stop 205
  allocate (a1(5))
  if (rank (a1) .ne. 1) stop 206
  call testit (a1, 1)
  call test1 (a1)

  ! Test the multi-dimensional arrays.
  if (rank (x3) .ne. 3) stop 207
  call testit (x3, 3)
  call test1 (x3)
  call test3 (x3, 1, 2, 1, 3)
  if (rank (y3) .ne. 3) stop 208
  call test3 (y3, 0, 1, -3, -1)
  if (rank (p3) .ne. 3) stop 209
  p3 => x3
  call testit (p3, 3)
  call test1 (p3)
  if (rank (p3) .ne. 3) stop 210
  call test3 (p3, 1, 2, 1, 3)
  if (rank (a3) .ne. 3) stop 211
  allocate (a3(2,3,4))
  call testit (a3, 3)
  call test1 (a3)
  if (rank (a3) .ne. 3) stop 212
  call test3 (a3, 1, 2, 1, 3)

  ! Test scalars.
  if (rank (x) .ne. 0) stop 213
  call testit (x, 0)
  call test0 (x)
  if (rank (-1) .ne. 0) stop 214
  call test0 (-1)
  if (rank (x1(1)) .ne. 0) stop 215
  call test0 (x1(1))

contains

  subroutine testit (a, r)
    integer :: a(..)
    integer :: r

    if (r .ne. rank(a))  stop 101
  end subroutine

  subroutine test0 (a)
    integer :: a(..)
    if (rank (a) .ne. 0) stop 103
    call testit (a, 0)
  end subroutine

  subroutine test1 (a)
    integer :: a(*)
    call testit (a, 1)
  end subroutine

  subroutine test3 (a, l1, u1, l2, u2)
    implicit none
    integer :: l1, u1, l2, u2
    integer :: a(l1:u1, l2:u2, *)
    call testit (a, 3)
  end subroutine

end program