! { 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" } }