OSDN Git Service

2011-12-19 Tobias Burnus <burnus@net-b.de>
[pf3gnuchains/gcc-fork.git] / 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 st(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   else
27     if (ucobound(x,dim=1) /= 4) call abort ()
28   end if
29 end subroutine s
30
31 subroutine st(x)
32   class(t) :: x(:)[4,2:*]
33 ! FIXME
34 !  if (any (lcobound(x) /= [1, 2])) call abort ()
35 !  if (lcobound(x, dim=1) /= 1) call abort ()
36 !  if (lcobound(x, dim=2) /= 2) call abort ()
37 !  if (this_image() == 1) then
38 !     if (any (this_image(x) /= lcobound(x))) call abort ()
39 !     if (this_image(x, dim=1) /= lcobound(x, dim=1)) call abort ()
40 !     if (this_image(x, dim=2) /= lcobound(x, dim=2)) call abort ()
41 !  end if
42 !  if (num_images() == 1) then
43 !     if (any (ucobound(x) /= [4, 2])) call abort ()
44 !     if (ucobound(x, dim=1) /= 4) call abort ()
45 !     if (ucobound(x, dim=2) /= 2) call abort ()
46 !  else
47 !    if (ucobound(x,dim=1) /= 4) call abort ()
48 !  end if
49 end subroutine st
50 end
51