blob: bbf1839e35961307fbe97bdad9149d37cd31c0e0 [file] [log] [blame]
! { 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.
module m
type :: base
integer :: a, b
end type
type, extends (base) :: derived
integer :: c
end type
end module
program test
use m
! Define some arrays for testing.
type(derived), target :: x1(5)
type(derived) :: y1(0:9)
type(derived), pointer :: p1(:)
type(derived), allocatable :: a1(:)
type(derived), target :: x3(2,3,4)
type(derived) :: y3(0:1,-3:-1,4)
type(derived), pointer :: p3(:,:,:)
type(derived), allocatable :: a3(:,:,:)
type(derived) :: x
! Test the 1-dimensional arrays.
if (rank (x1) .ne. 1) stop 201
call testit (x1, 1)
if (rank (y1) .ne. 1) stop 202
call testit (y1, 1)
if (rank (p1) .ne. 1) stop 203
p1 => x1
call testit (p1, 1)
if (rank (p1) .ne. 1) stop 204
if (rank (a1) .ne. 1) stop 205
allocate (a1(5))
if (rank (a1) .ne. 1) stop 206
call testit (a1, 1)
! Test the multi-dimensional arrays.
if (rank (x3) .ne. 3) stop 207
call testit (x3, 3)
if (rank (y3) .ne. 3) stop 208
if (rank (p3) .ne. 3) stop 209
p3 => x3
call testit (p3, 3)
if (rank (p3) .ne. 3) stop 210
if (rank (a3) .ne. 3) stop 211
allocate (a3(2,3,4))
call testit (a3, 3)
if (rank (a3) .ne. 3) stop 212
! Test scalars.
if (rank (x) .ne. 0) stop 213
call testit (x, 0)
call test0 (x)
if (rank (x1(1)) .ne. 0) stop 215
call test0 (x1(1))
contains
subroutine testit (a, r)
use m
class(base) :: a(..)
integer :: r
if (r .ne. rank(a)) stop 101
end subroutine
subroutine test0 (a)
use m
class(base) :: a(..)
if (rank (a) .ne. 0) stop 103
call testit (a, 0)
end subroutine
end program