Subversion Repositories openrisc

! { 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[*]) ! OK

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,*]) ! OK

  allocate(b[q,*]) ! OK

  allocate(c[q,*]) ! OK

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