aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/gfortran.dg/assumed_rank_7.f90
blob: f9ff3b9aa424531d9cf6a4526fba72e751d38ff1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
! { dg-do run }
!
! PR fortran/48820
!
! Handle type/class for assumed-rank arrays
!
! FIXME: Passing a CLASS to a CLASS has to be re-enabled.
implicit none
type t
  integer :: i
end type

class(T), allocatable :: ac(:,:)
type(T), allocatable :: at(:,:)
integer :: i

allocate(ac(2:3,2:4))
allocate(at(2:3,2:4))

i = 0
call foo(ac)
call foo(at)
call bar(ac)
call bar(at)
if (i /= 12) call abort()

contains
  subroutine bar(x)
    type(t) :: x(..)
    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
    if (size(x) /= 6) call abort()
    if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
    i = i + 1
    call foo(x)
    call bar2(x)
  end subroutine
  subroutine bar2(x)
    type(t) :: x(..)
    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
    if (size(x) /= 6) call abort()
    if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
    i = i + 1
  end subroutine
  subroutine foo(x)
    class(t) :: x(..)
    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
    if (size(x) /= 6) call abort()
    if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
    i = i + 1
    call foo2(x)
!    call bar2(x) ! Passing a CLASS to a TYPE does not yet work
  end subroutine
  subroutine foo2(x)
    class(t) :: x(..)
    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
    if (size(x) /= 6) call abort()
    if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
    i = i + 1
  end subroutine
end