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

   1 ! { dg-do run }
   2 !
   3 implicit none
   4 integer, allocatable :: A[:], B[:,:]
   5 integer :: n1, n2, n3
   6
   7 if (allocated (a)) call abort ()
   8 if (allocated (b)) call abort ()
   9
  10 allocate(a[*])
  11 a = 5 + this_image ()
  12 if (a[this_image ()] /= 5 + this_image ()) call abort
  13
  14 a[this_image ()] = 8 - 2*this_image ()
  15 if (a[this_image ()] /= 8 - 2*this_image ()) call abort
  16
  17 if (lcobound(a, dim=1) /= 1 .or. ucobound(a,dim=1) /= num_images()) &
  18   call abort ()
  19 deallocate(a)
  20
  21 allocate(a[4:*])
  22 a[this_image ()] = 8 - 2*this_image ()
  23
  24 if (lcobound(a, dim=1) /= 4 .or. ucobound(a,dim=1) /= 3 + num_images()) &
  25   call abort ()
  26
  27 n1 = -1
  28 n2 = 5
  29 n3 = 3
  30 allocate (B[n1:n2, n3:*])
  31 if (any (lcobound(b) /= [-1, 3]) .or. lcobound(B, dim=2) /= n3) &
  32   call abort()
  33 call sub(A, B)
  34
  35 if (allocated (a)) call abort ()
  36 if (.not.allocated (b)) call abort ()
  37
  38 call two(.true.)
  39 call two(.false.)
  40
  41 ! automatically deallocate "B"
  42 contains
  43   subroutine sub(x, y)
  44     integer, allocatable :: x[:], y[:,:]
  45
  46     if (any (lcobound(y) /= [-1, 3]) .or. lcobound(y, dim=2) /= n3) &
  47       call abort()
  48     if (lcobound(x, dim=1) /= 4 .or. ucobound(x,dim=1) /= 3 + num_images()) &
  49       call abort ()
  50     if (x[this_image ()] /= 8 - 2*this_image ()) call abort
  51     deallocate(x)
  52   end subroutine sub
  53
  54   subroutine two(init)
  55     logical, intent(in) :: init
  56     integer, allocatable, SAVE :: a[:]
  57
  58     if (init) then
  59       if (allocated(a)) call abort()
  60       allocate(a[*])
  61       a = 45
  62    else
  63       if (.not. allocated(a)) call abort()
  64       if (a /= 45) call abort()
  65       deallocate(a)
  66     end if
  67   end subroutine two
  68 end