OSDN Git Service

PR fortran/50420
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / coarray / subobject_1.f90
1 ! { dg-do run }
2 !
3 ! PR fortran/50420
4 ! Coarray subobjects were not accepted as valid coarrays
5
6   integer  :: i
7   integer, parameter :: la = 4, lb = 5, lc = 8
8   integer, parameter :: init(la) = -4 + (/ (i, i=1,la) /)
9   
10   type t
11     integer :: i
12   end type t
13   type t2
14     type(t), allocatable :: a[:]
15   end type t2
16   type t3
17     type(t), allocatable :: a(:)[:]
18   end type t3
19
20   type(t2) :: b
21   type(t3) :: c
22
23   allocate(b%a[lb:*])
24   b%a%i = 7
25   if (b%a%i /= 7) call abort
26   if (any (lcobound(b%a) /= (/ lb /))) call abort
27   if (ucobound(b%a, dim=1) /= this_image() + lb - 1) call abort
28   if (any (lcobound(b%a%i) /= (/ lb /))) call abort
29   if (ucobound(b%a%i, dim=1) /= this_image() + lb - 1) call abort
30   allocate(c%a(la)[lc:*])
31   c%a%i = init
32   if (any(c%a%i /= init)) call abort
33   if (any (lcobound(c%a) /= (/ lc /))) call abort
34   if (ucobound(c%a, dim=1) /= this_image() + lc - 1) call abort
35   if (any (lcobound(c%a%i) /= (/ lc /))) call abort
36   if (ucobound(c%a%i, dim=1) /= this_image() + lc - 1) call abort
37   if (c%a(2)%i /= init(2)) call abort
38   if (any (lcobound(c%a(2)) /= (/ lc /))) call abort
39   if (ucobound(c%a(2), dim=1) /= this_image() + lc - 1) call abort
40   if (any (lcobound(c%a(2)%i) /= (/ lc /))) call abort
41   if (ucobound(c%a(2)%i, dim=1) /= this_image() + lc - 1) call abort
42   deallocate(b%a, c%a)
43 end