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) call abort() 26 27contains 28 subroutine bar(x) 29 type(t) :: x(..) 30 if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort() 31 if (size(x) /= 6) call abort() 32 if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort() 33 if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort() 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) call abort() 41 if (size(x) /= 6) call abort() 42 if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort() 43 if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort() 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) call abort() 49 if (size(x) /= 6) call abort() 50 if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort() 51 if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort() 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) call abort() 59 if (size(x) /= 6) call abort() 60 if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort() 61 if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort() 62 i = i + 1 63 end subroutine 64end 65