gcc/testsuite/gfortran.dg/coarray/poly_run_1.f90

   1 ! { dg-do run }
   2 !
   3 ! Test for polymorphic coarrays
   4 !
   5 type t
   6 end type t
   7 class(t), allocatable :: A(:)[:,:]
   8 allocate (A(2)[1:4,-5:*])
   9 if (any (lcobound(A) /= [1, -5])) call abort ()
  10 if (num_images() == 1) then
  11   if (any (ucobound(A) /= [4, -5])) call abort ()
  12 else
  13   if (ucobound(A,dim=1) /= 4) call abort ()
  14 end if
  15 if (allocated(A)) i = 5
  16 call s(A)
  17 !call t(A) ! FIXME
  18
  19 contains
  20
  21 subroutine s(x)
  22   class(t),allocatable :: x(:)[:,:]
  23   if (any (lcobound(x) /= [1, -5])) call abort ()
  24   if (num_images() == 1) then
  25     if (any (ucobound(x) /= [4, -5])) call abort ()
  26 ! FIXME: Tree-walking issue?
  27 !  else
  28 !    if (ucobound(x,dim=1) /= 4) call abort ()
  29   end if
  30 end subroutine s
  31
  32 ! FIXME
  33 !subroutine st(x)
  34 !  class(t),allocatable :: x(:)[:,:]
  35 !  if (any (lcobound(x) /= [1, 2])) call abort ()
  36 !  if (num_images() == 1) then
  37 !    if (any (ucobound(x) /= [4, 2])) call abort ()
  38 !  else
  39 !    if (ucobound(x,dim=1) /= 4) call abort ()
  40 !  end if
  41 !end subroutine st
  42 end
  43