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