1 files changed, 175 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/coarray_7.f90 b/gcc/testsuite/gfortran.dg/coarray_7.f90
new file mode 100644
index 000000000..29af0d191
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_7.f90
@@ -0,0 +1,175 @@
+! { dg-do compile }
+! { dg-options "-fmax-errors=1000 -fcoarray=single" }
+!
+! PR fortran/18918
+!
+! Coarray expressions.
+!
+program test
+  implicit none
+  type t3
+    integer, allocatable :: a
+  end type t3
+  type t4
+    type(t3) :: xt3
+  end type t4
+  type t
+    integer, pointer :: ptr
+    integer, allocatable :: alloc(:)
+  end type t
+  type(t), target :: i[*]
+  type(t), allocatable :: ca[:]
+  type(t4), target :: tt4[*]
+  type(t4), allocatable :: ca2[:]
+  integer, volatile :: volat[*]
+  integer, asynchronous :: async[*]
+  integer :: caf1[1,*], caf2[*]
+  allocate(i%ptr)
+  call foo(i%ptr)
+  call foo(i[1]%ptr) ! { dg-error "Coindexed actual argument at .1. to pointer dummy" }
+  call bar(i%ptr)
+  call bar(i[1]%ptr) ! OK, value of ptr target 
+  call bar(i[1]%alloc(1)) ! OK
+  call typeDummy(i) ! OK
+  call typeDummy(i[1]) ! { dg-error "with ultimate pointer component" }
+  call typeDummy2(ca) ! OK
+  call typeDummy2(ca[1]) ! { dg-error "with ultimate pointer component" }
+  call typeDummy3(tt4%xt3) ! OK
+  call typeDummy3(tt4[1]%xt3) ! { dg-error "requires either VALUE or INTENT.IN." }
+  call typeDummy4(ca2) ! OK
+  call typeDummy4(ca2[1]) ! { dg-error "requires INTENT.IN." }
+! Note: Checking an VOLATILE dummy is not possible as volatile + intent(in)
+! is not possible
+
+  call asyn(volat)
+  call asyn(async)
+  call asyn(volat[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" }
+  call asyn(async[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" }
+
+  call coarray(caf1) ! rank mismatch; OK, for non allocatable coarrays
+  call coarray(caf2)
+  call coarray(caf2[1]) ! { dg-error "must be a coarray" }
+  call ups(i)
+  call ups(i[1]) ! { dg-error "with ultimate pointer component" }
+  call ups(i%ptr)
+  call ups(i[1]%ptr) ! OK - passes target not pointer
+contains
+  subroutine asyn(a)
+    integer, intent(in), asynchronous :: a
+  end subroutine asyn
+  subroutine bar(a)
+    integer :: a
+  end subroutine bar
+  subroutine foo(a)
+    integer, pointer :: a
+  end subroutine foo
+  subroutine coarray(a)
+    integer :: a[*]
+  end subroutine coarray
+  subroutine typeDummy(a)
+    type(t) :: a
+  end subroutine typeDummy
+  subroutine typeDummy2(a)
+    type(t),allocatable :: a
+  end subroutine typeDummy2
+  subroutine typeDummy3(a)
+    type(t3) :: a
+  end subroutine typeDummy3
+  subroutine typeDummy4(a)
+    type(t4), allocatable :: a
+  end subroutine typeDummy4
+end program test
+
+
+subroutine alloc()
+type t
+  integer, allocatable :: a(:)
+end type t
+type(t), save :: a[*]
+type(t), allocatable :: b(:)[:], C[:]
+
+allocate(b(1)) ! { dg-error "Coarray specification" }
+allocate(a[3]%a(5)) ! { dg-error "Coindexed allocatable" }
+allocate(c[*]) ! { dg-error "Sorry" }
+allocate(a%a(5)) ! OK
+end subroutine alloc
+
+
+subroutine dataPtr()
+  integer, save, target :: a[*]
+  data a/5/ ! OK
+  data a[1]/5/ ! { dg-error "cannot have a coindex" }
+  type t
+  integer, pointer :: p
+  end type t
+  type(t), save :: x[*]
+
+  type t2
+    integer :: a(1)
+  end type t2
+  type(t2) y
+  data y%a/4/
+
+
+   x[1]%p => a  ! { dg-error "shall not have a coindex" }
+   x%p => a[1]  ! { dg-error "shall not have a coindex" }
+end subroutine dataPtr
+
+
+subroutine test3()
+implicit none
+type t
+  integer :: a(1)
+end type t
+type(t), save :: x[*]
+data x%a/4/
+
+  integer, save :: y(1)[*] !(1)
+  call sub(x(1:1)[1]) ! { dg-error "Rank mismatch" }
+contains
+  subroutine sub(a) ! { dg-error "shall not have codimensions with deferred shape" }
+    integer :: a(:)[:]
+  end subroutine sub
+end subroutine test3
+
+
+subroutine test4()
+  integer, save :: i[*]
+  integer :: j
+  call foo(i)
+  call foo(j) ! { dg-error "must be a coarray" }
+contains
+  subroutine foo(a)
+    integer :: a[*]
+  end subroutine foo
+end subroutine test4
+
+
+subroutine allocateTest()
+  implicit none
+  real, allocatable, codimension[:,:] :: a,b,c
+  integer :: n, q
+  n = 1
+  q = 1
+  allocate(a[q,*]) ! { dg-error "Sorry" }
+  allocate(b[q,*]) ! { dg-error "Sorry" }
+  allocate(c[q,*]) ! { dg-error "Sorry" }
+end subroutine allocateTest
+
+
+subroutine testAlloc4()
+  implicit none
+  type co_double_3
+    double precision, allocatable :: array(:)
+  end type co_double_3
+  type(co_double_3),save, codimension[*] :: work
+  allocate(work%array(1))
+  print *, size(work%array)
+end subroutine testAlloc4
+
+subroutine test5()
+  implicit none
+  integer, save :: i[*]
+  print *, i[*] ! { dg-error "Coindex of codimension 1 must be a scalar" }
+end subroutine test5
+