1! { dg-do compile } 2! { dg-options "-fmax-errors=1000 -fcoarray=single" } 3! 4! PR fortran/18918 5! 6! Coarray expressions. 7! 8module mod2 9 implicit none 10 type t 11 procedure(sub), pointer :: ppc 12 contains 13 procedure :: tbp => sub 14 end type t 15 type t2 16 class(t), allocatable :: poly 17 end type t2 18contains 19 subroutine sub(this) 20 class(t), intent(in) :: this 21 end subroutine sub 22end module mod2 23 24subroutine procTest(y,z) 25 use mod2 26 implicit none 27 type(t), save :: x[*] 28 type(t) :: y[*] 29 type(t2) :: z[*] 30 31 x%ppc => sub 32 call x%ppc() ! OK 33 call x%tbp() ! OK 34 call x[1]%tbp ! OK, not polymorphic 35 ! Invalid per C726 36 call x[1]%ppc ! { dg-error "Coindexed procedure-pointer component" } 37 38 y%ppc => sub 39 call y%ppc() ! OK 40 call y%tbp() ! OK 41 call y[1]%tbp ! OK, coindexed polymorphic object but not poly. subobj. 42 call y[1]%ppc ! { dg-error "Coindexed procedure-pointer component" } 43 44 ! Invalid per C1229 45 z%poly%ppc => sub 46 call z%poly%ppc() ! OK 47 call z%poly%tbp() ! OK 48 call z[1]%poly%tbp ! { dg-error "Polymorphic subobject of coindexed" } 49 call z[1]%poly%ppc ! { dg-error "Coindexed procedure-pointer component" } 50end subroutine procTest 51 52 53module m 54 type t1 55 integer, pointer :: p 56 end type t1 57 type t2 58 integer :: i 59 end type t2 60 type t 61 integer, allocatable :: a[:] 62 type(t1), allocatable :: b[:] 63 type(t2), allocatable :: c[:] 64 end type t 65contains 66 pure subroutine p2(x) 67 integer, intent(inout) :: x 68 end subroutine p2 69 pure subroutine p3(x) 70 integer, pointer :: x 71 end subroutine p3 72 pure subroutine p1(x) 73 type(t), intent(inout) :: x 74 integer, target :: tgt1 75 x%a = 5 76 x%a[6] = 9 ! { dg-error "Assignment to coindexed variable" } 77 x%b%p => tgt1 78 x%b[1]%p => tgt1 ! { dg-error "shall not have a coindex" } 79 x%b%p => x%b[1]%p ! { dg-error "shall not have a coindex" } 80 x%b = t1(x%b[1]%p) ! { dg-error "Coindexed expression to pointer component" } 81 x%b = x%b[1] ! { dg-error "derived type variable with a POINTER component in a PURE" } 82 call p2 (x%c[1]%i) ! { dg-error "Coindexed actual argument" } 83 call p3 (x%b[1]%p) ! { dg-error "to pointer dummy" } 84 end subroutine p1 85 subroutine nonPtr() 86 type(t1), save :: a[*] 87 type(t2), save :: b[*] 88 integer, target :: tgt1 89 a%p => tgt1 90 a[1]%p => tgt1 ! { dg-error "shall not have a coindex" } 91 a%p => a[2]%p ! { dg-error "shall not have a coindex" } 92 a = t1(a[1]%p) ! { dg-error "Coindexed expression to pointer component" } 93 call p2 (b[1]%i) ! OK 94 call p2 (a[1]%p) ! OK - pointer target and not pointer 95 end subroutine nonPtr 96end module m 97 98 99module mmm3 100 type t 101 integer, allocatable :: a(:) 102 end type t 103contains 104 subroutine assign(x) 105 type(t) :: x[*] 106 allocate(x%a(3)) 107 x%a = [ 1, 2, 3] 108 x[1]%a = [ 1, 2, 3] ! OK - if shapes are the same, otherwise wrong 109 ! (no reallocate on assignment) 110 end subroutine assign 111 subroutine assign2(x,y) 112 type(t),allocatable :: x[:] 113 type(t) :: y 114 x = y 115 x[1] = y ! { dg-error "must not have an allocatable ultimate component" } 116 end subroutine assign2 117end module mmm3 118 119 120module mmm4 121 implicit none 122contains 123 subroutine t1(x) 124 integer :: x(1) 125 end subroutine t1 126 subroutine t3(x) 127 character :: x(*) 128 end subroutine t3 129 subroutine t2() 130 integer, save :: x[*] 131 integer, save :: y(1)[*] 132 character(len=20), save :: z[*] 133 134 call t1(x) ! { dg-error "Rank mismatch" } 135 call t1(x[1]) ! { dg-error "Rank mismatch" } 136 137 call t1(y(1)) ! OK 138 call t1(y(1)[1]) ! { dg-error "Rank mismatch" } 139 140 call t3(z) ! OK 141 call t3(z[1]) ! { dg-error "Rank mismatch" } 142 end subroutine t2 143end module mmm4 144 145 146subroutine tfgh() 147 integer :: i(2) 148 DATA i/(i, i=1,2)/ ! { dg-error "Expected PARAMETER symbol" } 149 do i = 1, 5 ! { dg-error "cannot be a sub-component" } 150 end do ! { dg-error "Expecting END SUBROUTINE" } 151end subroutine tfgh 152 153subroutine tfgh2() 154 integer, save :: x[*] 155 integer :: i(2) 156 DATA i/(x, x=1,2)/ ! { dg-error "Expected PARAMETER symbol" } 157 do x = 1, 5 ! { dg-error "cannot be a coarray" } 158 end do ! { dg-error "Expecting END SUBROUTINE" } 159end subroutine tfgh2 160 161 162subroutine f4f4() 163 type t 164 procedure(), pointer, nopass :: ppt => null() 165 end type t 166 external foo 167 type(t), save :: x[*] 168 x%ppt => foo 169 x[1]%ppt => foo ! { dg-error "shall not have a coindex" } 170end subroutine f4f4 171 172 173subroutine corank() 174 integer, allocatable :: a[:,:] 175 call one(a) ! OK 176 call two(a) ! { dg-error "Corank mismatch in argument" } 177contains 178 subroutine one(x) 179 integer :: x[*] 180 end subroutine one 181 subroutine two(x) 182 integer, allocatable :: x[:] 183 end subroutine two 184end subroutine corank 185 186subroutine assign42() 187 integer, allocatable :: z(:)[:] 188 z(:)[1] = z 189end subroutine assign42 190