view gcc/testsuite/gfortran.dg/assumed_rank_7.f90 @ 118:fd00160c1b76

ifdef TARGET_64BIT
author mir3636
date Tue, 27 Feb 2018 15:01:35 +0900
parents 04ced10e8804
children 84e7813d76e9
line wrap: on
line source

! { 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