obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.

1 files changed, 191 insertions, 0 deletions

diff --git a/gcc/testsuite/gfortran.dg/coarray_8.f90 b/gcc/testsuite/gfortran.dg/coarray_8.f90
new file mode 100644
index 000000000..6ceba8b9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_8.f90
@@ -0,0 +1,191 @@
+! { dg-do compile }
+! { dg-options "-fmax-errors=1000 -fcoarray=single" }
+!
+! PR fortran/18918
+!
+! Coarray expressions.
+!
+module mod2
+  implicit none
+  type t
+    procedure(sub), pointer :: ppc
+  contains
+    procedure :: tbp => sub
+  end type t
+  type t2
+    class(t), allocatable :: poly
+  end type t2
+contains
+  subroutine sub(this)
+    class(t), intent(in) :: this
+  end subroutine sub
+end module mod2
+
+subroutine procTest(y,z)
+  use mod2
+  implicit none
+  type(t), save :: x[*]
+  type(t) :: y[*]
+  type(t2) :: z[*]
+
+  x%ppc => sub
+  call x%ppc() ! OK
+  call x%tbp() ! OK
+  call x[1]%tbp ! OK, not polymorphic
+  ! Invalid per C726
+  call x[1]%ppc ! { dg-error "Coindexed procedure-pointer component" }
+
+  y%ppc => sub
+  call y%ppc() ! OK
+  call y%tbp() ! OK
+  call y[1]%tbp ! OK, coindexed polymorphic object but not poly. subobj.
+  call y[1]%ppc ! { dg-error "Coindexed procedure-pointer component" }
+
+  ! Invalid per C1229
+  z%poly%ppc => sub
+  call z%poly%ppc() ! OK
+  call z%poly%tbp() ! OK
+  call z[1]%poly%tbp ! { dg-error "Polymorphic subobject of coindexed" }
+  call z[1]%poly%ppc ! { dg-error "Coindexed procedure-pointer component" }
+end subroutine procTest
+
+
+module m
+  type t1
+    integer, pointer :: p
+  end type t1
+  type t2
+    integer :: i
+  end type t2
+  type t
+    integer, allocatable :: a[:]
+    type(t1), allocatable :: b[:]
+    type(t2), allocatable :: c[:]
+  end type t
+contains
+  pure subroutine p2(x)
+   integer, intent(inout) :: x
+  end subroutine p2
+  pure subroutine p3(x)
+   integer, pointer :: x
+  end subroutine p3
+  pure subroutine p1(x)
+    type(t), intent(inout) :: x
+    integer, target :: tgt1
+    x%a = 5
+    x%a[6] = 9 ! { dg-error "Assignment to coindexed variable" }
+    x%b%p => tgt1
+    x%b[1]%p => tgt1 ! { dg-error "shall not have a coindex" }
+    x%b%p => x%b[1]%p ! { dg-error "shall not have a coindex" }
+    x%b = t1(x%b[1]%p) ! { dg-error "Coindexed expression to pointer component" }
+    x%b = x%b[1] ! { dg-error "derived type variable with a POINTER component in a PURE" }
+    call p2 (x%c[1]%i) ! { dg-error "Coindexed actual argument" }
+    call p3 (x%b[1]%p) ! { dg-error "to pointer dummy" }
+  end subroutine p1
+  subroutine nonPtr()
+    type(t1), save :: a[*]
+    type(t2), save :: b[*]
+    integer, target :: tgt1
+    a%p => tgt1
+    a[1]%p => tgt1 ! { dg-error "shall not have a coindex" }
+    a%p => a[2]%p ! { dg-error "shall not have a coindex" }
+    a = t1(a[1]%p) ! { dg-error "Coindexed expression to pointer component" }
+    call p2 (b[1]%i) ! OK
+    call p2 (a[1]%p) ! OK - pointer target and not pointer
+  end subroutine nonPtr
+end module m
+
+
+module mmm3
+ type t
+   integer, allocatable :: a(:)
+ end type t
+contains
+  subroutine assign(x)
+    type(t) :: x[*]
+    allocate(x%a(3))
+    x%a = [ 1, 2, 3]
+    x[1]%a = [ 1, 2, 3] ! OK - if shapes are the same, otherwise wrong
+                        ! (no reallocate on assignment)
+  end subroutine assign
+  subroutine assign2(x,y)
+    type(t),allocatable :: x[:]
+    type(t) :: y
+    x = y
+    x[1] = y ! { dg-error "must not be have an allocatable ultimate component" }
+  end subroutine assign2
+end module mmm3
+
+
+module mmm4
+  implicit none
+contains
+  subroutine t1(x)
+    integer :: x(1)
+  end subroutine t1
+  subroutine t3(x)
+    character :: x(*)
+  end subroutine t3
+  subroutine t2()
+    integer, save :: x[*]
+    integer, save :: y(1)[*]
+    character(len=20), save :: z[*]
+
+    call t1(x) ! { dg-error "Rank mismatch" }
+    call t1(x[1]) ! { dg-error "Rank mismatch" }
+
+    call t1(y(1)) ! OK
+    call t1(y(1)[1]) ! { dg-error "Rank mismatch" }
+
+    call t3(z) !  OK
+    call t3(z[1]) ! { dg-error "Rank mismatch" }
+  end subroutine t2
+end module mmm4
+
+
+subroutine tfgh()
+  integer :: i(2)
+  DATA i/(i, i=1,2)/ ! { dg-error "Expected PARAMETER symbol" }
+  do i = 1, 5 ! { dg-error "cannot be a sub-component" }
+  end do ! { dg-error "Expecting END SUBROUTINE" }
+end subroutine tfgh
+
+subroutine tfgh2()
+  integer, save :: x[*]
+  integer :: i(2)
+  DATA i/(x, x=1,2)/ ! { dg-error "Expected PARAMETER symbol" }
+  do x = 1, 5 ! { dg-error "cannot be a coarray" }
+  end do ! { dg-error "Expecting END SUBROUTINE" }
+end subroutine tfgh2
+
+
+subroutine f4f4()
+  type t
+    procedure(), pointer, nopass :: ppt => null()
+  end type t
+  external foo
+  type(t), save :: x[*]
+  x%ppt => foo
+  x[1]%ppt => foo ! { dg-error "shall not have a coindex" }
+end subroutine f4f4
+
+
+subroutine corank()
+  integer, allocatable :: a[:,:]
+  call one(a) ! OK
+  call two(a) !  { dg-error "Corank mismatch in argument" }
+contains
+  subroutine one(x)
+    integer :: x[*]
+  end subroutine one
+  subroutine two(x)
+    integer, allocatable :: x[:]
+  end subroutine two
+end subroutine corank
+
+subroutine assign42()
+  integer, allocatable :: z(:)[:]
+  z(:)[1] = z
+end subroutine assign42
+
+! { dg-final { cleanup-modules "mod2 m mmm3 mmm4" } }