1! { dg-do run } 2! 3! PR fortran/48820 4! 5! Handle type/class for assumed-rank arrays 6! 7! FIXME: Passing a CLASS to a CLASS has to be re-enabled. 8implicit none 9type t 10 integer :: i 11end type 12 13class(T), allocatable :: ac(:,:) 14type(T), allocatable :: at(:,:) 15integer :: i 16 17allocate(ac(2:3,2:4)) 18allocate(at(2:3,2:4)) 19 20i = 0 21call foo(ac) 22call foo(at) 23call bar(ac) 24call bar(at) 25if (i /= 12) STOP 1 26 27contains 28 subroutine bar(x) 29 type(t) :: x(..) 30 if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) STOP 2 31 if (size(x) /= 6) STOP 3 32 if (size(x,1) /= 2 .or. size(x,2) /= 3) STOP 4 33 if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) STOP 5 34 i = i + 1 35 call foo(x) 36 call bar2(x) 37 end subroutine 38 subroutine bar2(x) 39 type(t) :: x(..) 40 if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) STOP 6 41 if (size(x) /= 6) STOP 7 42 if (size(x,1) /= 2 .or. size(x,2) /= 3) STOP 8 43 if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) STOP 9 44 i = i + 1 45 end subroutine 46 subroutine foo(x) 47 class(t) :: x(..) 48 if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) STOP 10 49 if (size(x) /= 6) STOP 11 50 if (size(x,1) /= 2 .or. size(x,2) /= 3) STOP 12 51 if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) STOP 13 52 i = i + 1 53 call foo2(x) 54! call bar2(x) ! Passing a CLASS to a TYPE does not yet work 55 end subroutine 56 subroutine foo2(x) 57 class(t) :: x(..) 58 if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) STOP 14 59 if (size(x) /= 6) STOP 15 60 if (size(x,1) /= 2 .or. size(x,2) /= 3) STOP 16 61 if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) STOP 17 62 i = i + 1 63 end subroutine 64end 65