1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic 2! Test 15.5.2.5 constraints and restrictions for POINTER & ALLOCATABLE 3! arguments when both sides of the call have the same attributes. 4 5module m 6 7 type :: t 8 end type 9 type, extends(t) :: t2 10 end type 11 type :: pdt(n) 12 integer, len :: n 13 end type 14 15 type(t), pointer :: mp(:), mpmat(:,:) 16 type(t), allocatable :: ma(:), mamat(:,:) 17 class(t), pointer :: pp(:) 18 class(t), allocatable :: pa(:) 19 class(t2), pointer :: pp2(:) 20 class(t2), allocatable :: pa2(:) 21 class(*), pointer :: up(:) 22 class(*), allocatable :: ua(:) 23 !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result 24 type(pdt(*)), pointer :: amp(:) 25 !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result 26 type(pdt(*)), allocatable :: ama(:) 27 type(pdt(:)), pointer :: dmp(:) 28 type(pdt(:)), allocatable :: dma(:) 29 type(pdt(1)), pointer :: nmp(:) 30 type(pdt(1)), allocatable :: nma(:) 31 32 contains 33 34 subroutine smp(x) 35 type(t), pointer :: x(:) 36 end subroutine 37 subroutine sma(x) 38 type(t), allocatable :: x(:) 39 end subroutine 40 subroutine spp(x) 41 class(t), pointer :: x(:) 42 end subroutine 43 subroutine spa(x) 44 class(t), allocatable :: x(:) 45 end subroutine 46 subroutine sup(x) 47 class(*), pointer :: x(:) 48 end subroutine 49 subroutine sua(x) 50 class(*), allocatable :: x(:) 51 end subroutine 52 subroutine samp(x) 53 type(pdt(*)), pointer :: x(:) 54 end subroutine 55 subroutine sama(x) 56 type(pdt(*)), allocatable :: x(:) 57 end subroutine 58 subroutine sdmp(x) 59 type(pdt(:)), pointer :: x(:) 60 end subroutine 61 subroutine sdma(x) 62 type(pdt(:)), allocatable :: x(:) 63 end subroutine 64 subroutine snmp(x) 65 type(pdt(1)), pointer :: x(:) 66 end subroutine 67 subroutine snma(x) 68 type(pdt(1)), allocatable :: x(:) 69 end subroutine 70 71 subroutine test 72 call smp(mp) ! ok 73 call sma(ma) ! ok 74 call spp(pp) ! ok 75 call spa(pa) ! ok 76 !PORTABILITY: If a POINTER or ALLOCATABLE actual argument is polymorphic, the corresponding dummy argument should also be so 77 call smp(pp) 78 !PORTABILITY: If a POINTER or ALLOCATABLE actual argument is polymorphic, the corresponding dummy argument should also be so 79 call sma(pa) 80 !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so 81 call spp(mp) 82 !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so 83 call spa(ma) 84 !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so 85 call sup(pp) 86 !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so 87 call sua(pa) 88 !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 'CLASS(t)' 89 !ERROR: Pointer type must be unlimited polymorphic or non-extensible derived type when target is unlimited polymorphic 90 call spp(up) 91 !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 'CLASS(t)' 92 call spa(ua) 93 !ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind 94 call spp(pp2) 95 !ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind 96 call spa(pa2) 97 !ERROR: Rank of dummy argument is 1, but actual argument has rank 2 98 !ERROR: Pointer has rank 1 but target has rank 2 99 call smp(mpmat) 100 !ERROR: Rank of dummy argument is 1, but actual argument has rank 2 101 call sma(mamat) 102 call sdmp(dmp) ! ok 103 call sdma(dma) ! ok 104 call snmp(nmp) ! ok 105 call snma(nma) ! ok 106 call samp(nmp) ! ok 107 call sama(nma) ! ok 108 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 109 call sdmp(nmp) 110 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 111 call sdma(nma) 112 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 113 call snmp(dmp) 114 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 115 call snma(dma) 116 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 117 call samp(dmp) 118 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 119 call sama(dma) 120 end subroutine 121 122end module 123 124module m2 125 126 character(len=10), allocatable :: t1, t2, t3, t4 127 character(len=:), allocatable :: t5, t6, t7, t8(:) 128 129 character(len=10), pointer :: p1 130 character(len=:), pointer :: p2 131 132 integer, allocatable :: x(:) 133 134 contains 135 136 subroutine sma(a) 137 character(len=:), allocatable, intent(in) :: a 138 end 139 140 subroutine sma2(a) 141 character(len=10), allocatable, intent(in) :: a 142 end 143 144 subroutine smp(p) 145 character(len=:), pointer, intent(in) :: p 146 end 147 148 subroutine smp2(p) 149 character(len=10), pointer, intent(in) :: p 150 end 151 152 subroutine smb(b) 153 integer, allocatable, intent(in) :: b(:) 154 end 155 156 function return_deferred_length_ptr() 157 character(len=:), pointer :: return_deferred_length_ptr 158 return_deferred_length_ptr => p2 159 end function 160 161 function return_explicit_length_ptr(n) 162 integer :: n 163 character(len=n), pointer :: return_explicit_length_ptr 164 return_explicit_length_ptr => p2(1:n) 165 end function 166 167 subroutine test() 168 169 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 170 call sma(t1) 171 172 call sma2(t1) ! ok 173 174 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 175 call smp(p1) 176 177 call smp2(p1) ! ok 178 179 call smp(return_deferred_length_ptr()) ! ok 180 181 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 182 call smp2(return_deferred_length_ptr()) 183 184 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 185 call smp(return_explicit_length_ptr(10)) 186 187 call smp2(return_explicit_length_ptr(10)) ! ok 188 189 !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument 190 call sma(t2(:)) 191 192 !ERROR: 't3' is not a callable procedure 193 call sma(t3(1)) 194 195 !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument 196 call sma(t4(1:2)) 197 198 call sma(t5) ! ok 199 200 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 201 call sma2(t5) 202 203 call smp(p2) ! ok 204 205 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 206 call smp2(p2) 207 208 !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument 209 call sma(t5(:)) 210 211 !ERROR: 't6' is not a callable procedure 212 call sma(t6(1)) 213 214 !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument 215 call sma(t7(1:2)) 216 217 !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument 218 call sma(t8(1)) 219 220 !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument 221 call smb(x(:)) 222 223 !ERROR: Rank of dummy argument is 1, but actual argument has rank 0 224 !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument 225 call smb(x(2)) 226 227 !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument 228 call smb(x(1:2)) 229 230 end subroutine 231 232end module 233 234module test 235 type t(l) 236 integer, len :: l 237 character(l) :: c 238 end type 239 240 contains 241 242 subroutine bar(p) 243 type(t(:)), allocatable :: p(:) 244 end subroutine 245 246 subroutine foo 247 type(t(10)), allocatable :: p(:) 248 249 !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE 250 call bar(p) 251 252 end subroutine 253 254end module 255