gcc/testsuite/gfortran.dg/coarray_7.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fmax-errors=1000 -fcoarray=single" }
   3 !
   4 ! PR fortran/18918
   5 !
   6 ! Coarray expressions.
   7 !
   8 program test
   9   implicit none
  10   type t3
  11     integer, allocatable :: a
  12   end type t3
  13   type t4
  14     type(t3) :: xt3
  15   end type t4
  16   type t
  17     integer, pointer :: ptr
  18     integer, allocatable :: alloc(:)
  19   end type t
  20   type(t), target :: i[*]
  21   type(t), allocatable :: ca[:]
  22   type(t4), target :: tt4[*]
  23   type(t4), allocatable :: ca2[:]
  24   integer, volatile :: volat[*]
  25   integer, asynchronous :: async[*]
  26   integer :: caf1[1,*], caf2[*]
  27   allocate(i%ptr)
  28   call foo(i%ptr)
  29   call foo(i[1]%ptr) ! { dg-error "Coindexed actual argument at .1. to pointer dummy" }
  30   call bar(i%ptr)
  31   call bar(i[1]%ptr) ! OK, value of ptr target
  32   call bar(i[1]%alloc(1)) ! OK
  33   call typeDummy(i) ! OK
  34   call typeDummy(i[1]) ! { dg-error "with ultimate pointer component" }
  35   call typeDummy2(ca) ! OK
  36   call typeDummy2(ca[1]) ! { dg-error "with ultimate pointer component" }
  37   call typeDummy3(tt4%xt3) ! OK
  38   call typeDummy3(tt4[1]%xt3) ! { dg-error "requires either VALUE or INTENT.IN." }
  39   call typeDummy4(ca2) ! OK
  40   call typeDummy4(ca2[1]) ! { dg-error "requires INTENT.IN." }
  41 ! Note: Checking an VOLATILE dummy is not possible as volatile + intent(in)
  42 ! is not possible
  43
  44   call asyn(volat)
  45   call asyn(async)
  46   call asyn(volat[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" }
  47   call asyn(async[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" }
  48
  49   call coarray(caf1) ! rank mismatch; OK, for non allocatable coarrays
  50   call coarray(caf2)
  51   call coarray(caf2[1]) ! { dg-error "must be a coarray" }
  52   call ups(i)
  53   call ups(i[1]) ! { dg-error "with ultimate pointer component" }
  54   call ups(i%ptr)
  55   call ups(i[1]%ptr) ! OK - passes target not pointer
  56 contains
  57   subroutine asyn(a)
  58     integer, intent(in), asynchronous :: a
  59   end subroutine asyn
  60   subroutine bar(a)
  61     integer :: a
  62   end subroutine bar
  63   subroutine foo(a)
  64     integer, pointer :: a
  65   end subroutine foo
  66   subroutine coarray(a)
  67     integer :: a[*]
  68   end subroutine coarray
  69   subroutine typeDummy(a)
  70     type(t) :: a
  71   end subroutine typeDummy
  72   subroutine typeDummy2(a)
  73     type(t),allocatable :: a
  74   end subroutine typeDummy2
  75   subroutine typeDummy3(a)
  76     type(t3) :: a
  77   end subroutine typeDummy3
  78   subroutine typeDummy4(a)
  79     type(t4), allocatable :: a
  80   end subroutine typeDummy4
  81 end program test
  82
  83
  84 subroutine alloc()
  85 type t
  86   integer, allocatable :: a(:)
  87 end type t
  88 type(t), save :: a[*]
  89 type(t), allocatable :: b(:)[:], C[:]
  90
  91 allocate(b(1)) ! { dg-error "Coarray specification" }
  92 allocate(a[3]%a(5)) ! { dg-error "Coindexed allocatable" }
  93 allocate(c[*]) ! { dg-error "Sorry" }
  94 allocate(b(3)[5:*]) ! { dg-error "Sorry" }
  95 allocate(a%a(5)) ! OK
  96 end subroutine alloc
  97
  98
  99 subroutine dataPtr()
 100   integer, save, target :: a[*]
 101   data a/5/ ! OK
 102   data a[1]/5/ ! { dg-error "cannot have a coindex" }
 103   type t
 104   integer, pointer :: p
 105   end type t
 106   type(t), save :: x[*]
 107
 108   type t2
 109     integer :: a(1)
 110   end type t2
 111   type(t2) y
 112   data y%a/4/
 113
 114
 115    x[1]%p => a  ! { dg-error "shall not have a coindex" }
 116    x%p => a[1]  ! { dg-error "shall not have a coindex" }
 117 end subroutine dataPtr
 118
 119
 120 subroutine test3()
 121 implicit none
 122 type t
 123   integer :: a(1)
 124 end type t
 125 type(t), save :: x[*]
 126 data x%a/4/
 127
 128   integer, save :: y(1)[*] !(1)
 129   call sub(x(1:1)[1]) ! { dg-error "Rank mismatch" }
 130 contains
 131   subroutine sub(a) ! { dg-error "shall not have codimensions with deferred shape" }
 132     integer :: a(:)[:]
 133   end subroutine sub
 134 end subroutine test3
 135
 136
 137 subroutine test4()
 138   integer, save :: i[*]
 139   integer :: j
 140   call foo(i)
 141   call foo(j) ! { dg-error "must be a coarray" }
 142 contains
 143   subroutine foo(a)
 144     integer :: a[*]
 145   end subroutine foo
 146 end subroutine test4
 147
 148
 149 subroutine allocateTest()
 150   implicit none
 151   real, allocatable,dimension(:,:), codimension[:,:] :: a,b,c
 152   integer :: n, q
 153   n = 1
 154   q = 1
 155   allocate(a(n,n)[q,*]) ! { dg-error "Sorry" }
 156   allocate(b(n,n)[q,*]) ! { dg-error "Sorry" }
 157   allocate(c(n,n)[q,*]) ! { dg-error "Sorry" }
 158 end subroutine allocateTest
 159
 160
 161 subroutine testAlloc3
 162 implicit none
 163 integer, allocatable :: a(:,:,:)[:,:]
 164 integer, allocatable, dimension(:),codimension[:] :: b(:,:,:)[:,:]
 165 integer, allocatable, dimension(:,:),codimension[:,:,:] :: c
 166 integer, allocatable, dimension(:,:),codimension[:,:,:] :: d[:,:]
 167 integer, allocatable, dimension(:,:,:),codimension[:,:,:] :: e(:,:)
 168 integer, allocatable, dimension(:,:,:),codimension[:,:,:] :: f(:,:)[:,:]
 169
 170 allocate(a(1,2,3)[4,*]) ! { dg-error "Sorry" }
 171 allocate(b(1,2,3)[4,*]) ! { dg-error "Sorry" }
 172 allocate(c(1,2)[3,4,*]) ! { dg-error "Sorry" }
 173 allocate(d(1,2)[3,*])   ! { dg-error "Sorry" }
 174 allocate(e(1,2)[3,4,*]) ! { dg-error "Sorry" }
 175 allocate(f(1,2)[3,*]) ! { dg-error "Sorry" }
 176 end subroutine testAlloc3
 177
 178
 179 subroutine testAlloc4()
 180   implicit none
 181   type co_double_3
 182     double precision, allocatable :: array(:)
 183   end type co_double_3
 184   type(co_double_3),save, codimension[*] :: work
 185   allocate(work%array(1))
 186   print *, size(work%array)
 187 end subroutine testAlloc4
 188
 189 subroutine test5()
 190   implicit none
 191   integer, save :: i[*]
 192   print *, i[*] ! { dg-error "Coindex of codimension 1 must be a scalar" }
 193 end subroutine test5
 194