1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic 2! Test 15.5.2.4 constraints and restrictions for non-POINTER non-ALLOCATABLE 3! dummy arguments. 4 5module m01 6 type :: t 7 end type 8 type :: pdt(n) 9 integer, len :: n 10 end type 11 type :: pdtWithDefault(n) 12 integer, len :: n = 3 13 end type 14 type :: tbp 15 contains 16 procedure :: binding => subr01 17 end type 18 type :: final 19 contains 20 final :: subr02 21 end type 22 type :: alloc 23 real, allocatable :: a(:) 24 end type 25 type :: ultimateCoarray 26 real, allocatable :: a[:] 27 end type 28 29 contains 30 31 subroutine subr01(this) 32 class(tbp), intent(in) :: this 33 end subroutine 34 subroutine subr02(this) 35 type(final), intent(inout) :: this 36 end subroutine 37 38 subroutine poly(x) 39 class(t), intent(in) :: x 40 end subroutine 41 subroutine polyassumedsize(x) 42 class(t), intent(in) :: x(*) 43 end subroutine 44 subroutine assumedsize(x) 45 real :: x(*) 46 end subroutine 47 subroutine assumedrank(x) 48 real :: x(..) 49 end subroutine 50 subroutine assumedtypeandsize(x) 51 type(*) :: x(*) 52 end subroutine 53 subroutine assumedshape(x) 54 real :: x(:) 55 end subroutine 56 subroutine contiguous(x) 57 real, contiguous :: x(:) 58 end subroutine 59 subroutine intentout(x) 60 real, intent(out) :: x 61 end subroutine 62 subroutine intentout_arr(x) 63 real, intent(out) :: x(:) 64 end subroutine 65 subroutine intentinout(x) 66 real, intent(in out) :: x 67 end subroutine 68 subroutine intentinout_arr(x) 69 real, intent(in out) :: x(:) 70 end subroutine 71 subroutine asynchronous(x) 72 real, asynchronous :: x 73 end subroutine 74 subroutine asynchronous_arr(x) 75 real, asynchronous :: x(:) 76 end subroutine 77 subroutine asynchronousValue(x) 78 real, asynchronous, value :: x 79 end subroutine 80 subroutine volatile(x) 81 real, volatile :: x 82 end subroutine 83 subroutine volatile_arr(x) 84 real, volatile :: x(:) 85 end subroutine 86 subroutine pointer(x) 87 real, pointer :: x(:) 88 end subroutine 89 subroutine valueassumedsize(x) 90 real, intent(in) :: x(*) 91 end subroutine 92 subroutine volatileassumedsize(x) 93 real, volatile :: x(*) 94 end subroutine 95 subroutine volatilecontiguous(x) 96 real, volatile :: x(*) 97 end subroutine 98 99 subroutine test01(x) ! 15.5.2.4(2) 100 class(t), intent(in) :: x[*] 101 !ERROR: Coindexed polymorphic object may not be associated with a polymorphic dummy argument 'x=' 102 call poly(x[1]) 103 end subroutine 104 105 subroutine mono(x) 106 type(t), intent(in) :: x(*) 107 end subroutine 108 subroutine test02(x) ! 15.5.2.4(2) 109 class(t), intent(in) :: x(*) 110 !ERROR: Assumed-size polymorphic array may not be associated with a monomorphic dummy argument 'x=' 111 call mono(x) 112 end subroutine 113 114 subroutine typestar(x) 115 type(*), intent(in) :: x 116 end subroutine 117 subroutine test03 ! 15.5.2.4(2) 118 type(pdt(0)) :: x 119 !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have a parameterized derived type 120 call typestar(x) 121 end subroutine 122 123 subroutine test04 ! 15.5.2.4(2) 124 type(tbp) :: x 125 !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have type-bound procedure 'binding' 126 call typestar(x) 127 end subroutine 128 129 subroutine test05 ! 15.5.2.4(2) 130 type(final) :: x 131 !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have derived type 'final' with FINAL subroutine 'subr02' 132 call typestar(x) 133 end subroutine 134 135 subroutine ch2(x) 136 character(2), intent(in) :: x 137 end subroutine 138 subroutine pdtdefault (derivedArg) 139 !ERROR: Type parameter 'n' lacks a value and has no default 140 type(pdt) :: derivedArg 141 end subroutine pdtdefault 142 subroutine pdt3 (derivedArg) 143 type(pdt(4)) :: derivedArg 144 end subroutine pdt3 145 subroutine pdt4 (derivedArg) 146 type(pdt(*)) :: derivedArg 147 end subroutine pdt4 148 subroutine pdtWithDefaultDefault (derivedArg) 149 type(pdtWithDefault) :: derivedArg 150 end subroutine pdtWithDefaultdefault 151 subroutine pdtWithDefault3 (derivedArg) 152 type(pdtWithDefault(4)) :: derivedArg 153 end subroutine pdtWithDefault3 154 subroutine pdtWithDefault4 (derivedArg) 155 type(pdtWithDefault(*)) :: derivedArg 156 end subroutine pdtWithDefault4 157 subroutine test06 ! 15.5.2.4(4) 158 !ERROR: Type parameter 'n' lacks a value and has no default 159 type(pdt) :: vardefault 160 type(pdt(3)) :: var3 161 type(pdt(4)) :: var4 162 type(pdtWithDefault) :: defaultVardefault 163 type(pdtWithDefault(3)) :: defaultVar3 164 type(pdtWithDefault(4)) :: defaultVar4 165 character :: ch1 166 !ERROR: Actual argument variable length '1' is less than expected length '2' 167 call ch2(ch1) 168 !WARNING: Actual argument expression length '0' is less than expected length '2' 169 call ch2("") 170 call pdtdefault(vardefault) 171 !ERROR: Actual argument type 'pdt(n=3_4)' is not compatible with dummy argument type 'pdt' 172 call pdtdefault(var3) 173 !ERROR: Actual argument type 'pdt(n=4_4)' is not compatible with dummy argument type 'pdt' 174 call pdtdefault(var4) ! error 175 !ERROR: Actual argument type 'pdt' is not compatible with dummy argument type 'pdt(n=4_4)' 176 call pdt3(vardefault) 177 !ERROR: Actual argument type 'pdt(n=3_4)' is not compatible with dummy argument type 'pdt(n=4_4)' 178 call pdt3(var3) 179 call pdt3(var4) 180 !ERROR: Actual argument type 'pdt' is not compatible with dummy argument type 'pdt(n=*)' 181 call pdt4(vardefault) 182 call pdt4(var3) 183 call pdt4(var4) 184 call pdtWithDefaultdefault(defaultVardefault) 185 call pdtWithDefaultdefault(defaultVar3) 186 !ERROR: Actual argument type 'pdtwithdefault(n=4_4)' is not compatible with dummy argument type 'pdtwithdefault(n=3_4)' 187 call pdtWithDefaultdefault(defaultVar4) ! error 188 !ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)' 189 call pdtWithDefault3(defaultVardefault) ! error 190 !ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)' 191 call pdtWithDefault3(defaultVar3) ! error 192 call pdtWithDefault3(defaultVar4) 193 call pdtWithDefault4(defaultVardefault) 194 call pdtWithDefault4(defaultVar3) 195 call pdtWithDefault4(defaultVar4) 196 end subroutine 197 198 subroutine out01(x) 199 type(alloc) :: x 200 end subroutine 201 subroutine test07(x) ! 15.5.2.4(6) 202 type(alloc) :: x[*] 203 !ERROR: Coindexed actual argument with ALLOCATABLE ultimate component '%a' must be associated with a dummy argument 'x=' with VALUE or INTENT(IN) attributes 204 call out01(x[1]) 205 end subroutine 206 207 subroutine test08(x) ! 15.5.2.4(13) 208 real :: x(1)[*] 209 !ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument 'x=' 210 call assumedsize(x(1)[1]) 211 end subroutine 212 213 subroutine charray(x) 214 character :: x(10) 215 end subroutine 216 subroutine test09(ashape, polyarray, c, assumed_shape_char) ! 15.5.2.4(14), 15.5.2.11 217 real :: x, arr(10) 218 real, pointer :: p(:) 219 real, pointer :: p_scalar 220 character(10), pointer :: char_pointer(:) 221 character(*) :: assumed_shape_char(:) 222 real :: ashape(:) 223 class(t) :: polyarray(*) 224 character(10) :: c(:) 225 !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array 226 call assumedsize(x) 227 !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array 228 call assumedsize(p_scalar) 229 !ERROR: Element of pointer array may not be associated with a dummy argument 'x=' array 230 call assumedsize(p(1)) 231 !ERROR: Element of assumed-shape array may not be associated with a dummy argument 'x=' array 232 call assumedsize(ashape(1)) 233 !ERROR: Polymorphic scalar may not be associated with a dummy argument 'x=' array 234 call polyassumedsize(polyarray(1)) 235 call charray(c(1:1)) ! not an error if character 236 call charray(char_pointer(1)) ! not an error if character 237 call charray(assumed_shape_char(1)) ! not an error if character 238 call assumedsize(arr(1)) ! not an error if element in sequence 239 call assumedrank(x) ! not an error 240 call assumedtypeandsize(x) ! not an error 241 end subroutine 242 243 subroutine test10(a) ! 15.5.2.4(16) 244 real :: scalar, matrix(2,3) 245 real :: a(*) 246 !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'x=' 247 call assumedshape(scalar) 248 call assumedshape(reshape(matrix,shape=[size(matrix)])) ! ok 249 !ERROR: Rank of dummy argument is 1, but actual argument has rank 2 250 call assumedshape(matrix) 251 !ERROR: Assumed-size array may not be associated with assumed-shape dummy argument 'x=' 252 call assumedshape(a) 253 end subroutine 254 255 subroutine test11(in) ! C15.5.2.4(20) 256 real, intent(in) :: in 257 real :: x 258 x = 0. 259 !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable 260 !BECAUSE: 'in' is an INTENT(IN) dummy argument 261 call intentout(in) 262 !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable 263 !BECAUSE: '3.141590118408203125_4' is not a variable or pointer 264 call intentout(3.14159) 265 !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable 266 !BECAUSE: 'in+1._4' is not a variable or pointer 267 call intentout(in + 1.) 268 call intentout(x) ! ok 269 !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable 270 !BECAUSE: '(x)' is not a variable or pointer 271 call intentout((x)) 272 !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' is not definable 273 !BECAUSE: '2_4' is not a variable or pointer 274 call system_clock(count=2) 275 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable 276 !BECAUSE: 'in' is an INTENT(IN) dummy argument 277 call intentinout(in) 278 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable 279 !BECAUSE: '3.141590118408203125_4' is not a variable or pointer 280 call intentinout(3.14159) 281 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable 282 !BECAUSE: 'in+1._4' is not a variable or pointer 283 call intentinout(in + 1.) 284 call intentinout(x) ! ok 285 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable 286 !BECAUSE: '(x)' is not a variable or pointer 287 call intentinout((x)) 288 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' is not definable 289 !BECAUSE: '0_4' is not a variable or pointer 290 call execute_command_line(command="echo hello", exitstat=0) 291 end subroutine 292 293 subroutine test12 ! 15.5.2.4(21) 294 real :: a(1) 295 integer :: j(1) 296 j(1) = 1 297 !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable 298 !BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript 299 call intentout_arr(a(j)) 300 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable 301 !BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript 302 call intentinout_arr(a(j)) 303 !WARNING: Actual argument associated with ASYNCHRONOUS dummy argument 'x=' is not definable 304 !BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript 305 call asynchronous_arr(a(j)) 306 !WARNING: Actual argument associated with VOLATILE dummy argument 'x=' is not definable 307 !BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript 308 call volatile_arr(a(j)) 309 end subroutine 310 311 subroutine coarr(x) 312 type(ultimateCoarray):: x 313 end subroutine 314 subroutine volcoarr(x) 315 type(ultimateCoarray), volatile :: x 316 end subroutine 317 subroutine test13(a, b) ! 15.5.2.4(22) 318 type(ultimateCoarray) :: a 319 type(ultimateCoarray), volatile :: b 320 call coarr(a) ! ok 321 call volcoarr(b) ! ok 322 !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a' 323 call coarr(b) 324 !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a' 325 call volcoarr(a) 326 end subroutine 327 328 subroutine test14(a,b,c,d) ! C1538 329 real :: a[*] 330 real, asynchronous :: b[*] 331 real, volatile :: c[*] 332 real, asynchronous, volatile :: d[*] 333 call asynchronous(a[1]) ! ok 334 call volatile(a[1]) ! ok 335 call asynchronousValue(b[1]) ! ok 336 call asynchronousValue(c[1]) ! ok 337 call asynchronousValue(d[1]) ! ok 338 !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE 339 call asynchronous(b[1]) 340 !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE 341 call volatile(b[1]) 342 !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE 343 call asynchronous(c[1]) 344 !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE 345 call volatile(c[1]) 346 !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE 347 call asynchronous(d[1]) 348 !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE 349 call volatile(d[1]) 350 end subroutine 351 352 subroutine test15(assumedrank) ! C1539 353 real, pointer :: a(:) 354 real, asynchronous :: b(10) 355 real, volatile :: c(10) 356 real, asynchronous, volatile :: d(10) 357 real, asynchronous, volatile :: assumedrank(..) 358 call assumedsize(a(::2)) ! ok 359 call contiguous(a(::2)) ! ok 360 call valueassumedsize(a(::2)) ! ok 361 call valueassumedsize(b(::2)) ! ok 362 call valueassumedsize(c(::2)) ! ok 363 call valueassumedsize(d(::2)) ! ok 364 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 365 call volatileassumedsize(b(::2)) 366 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 367 call volatilecontiguous(b(::2)) 368 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 369 call volatileassumedsize(c(::2)) 370 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 371 call volatilecontiguous(c(::2)) 372 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 373 call volatileassumedsize(d(::2)) 374 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 375 call volatilecontiguous(d(::2)) 376 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 377 call volatilecontiguous(assumedrank) 378 end subroutine 379 380 subroutine test16() ! C1540 381 real, pointer :: a(:) 382 real, asynchronous, pointer :: b(:) 383 real, volatile, pointer :: c(:) 384 real, asynchronous, volatile, pointer :: d(:) 385 call assumedsize(a) ! ok 386 call contiguous(a) ! ok 387 call pointer(a) ! ok 388 call pointer(b) ! ok 389 call pointer(c) ! ok 390 call pointer(d) ! ok 391 call valueassumedsize(a) ! ok 392 call valueassumedsize(b) ! ok 393 call valueassumedsize(c) ! ok 394 call valueassumedsize(d) ! ok 395 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 396 call volatileassumedsize(b) 397 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 398 call volatilecontiguous(b) 399 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 400 call volatileassumedsize(c) 401 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 402 call volatilecontiguous(c) 403 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 404 call volatileassumedsize(d) 405 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 406 call volatilecontiguous(d) 407 end subroutine 408 409 subroutine explicitAsyncContig(x) 410 real, asynchronous, intent(in out), contiguous :: x(:) 411 end 412 subroutine implicitAsyncContig(x) 413 real, intent(in out), contiguous :: x(:) 414 read(1,id=id,asynchronous="yes") x 415 end 416 subroutine test17explicit(x) 417 real, asynchronous, intent(in out) :: x(:) 418 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 419 call explicitAsyncContig(x) 420 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 421 call implicitAsyncContig(x) 422 end 423 subroutine test17implicit(x) 424 real, intent(in out) :: x(:) 425 read(1,id=id,asynchronous="yes") x 426 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 427 call explicitAsyncContig(x) 428 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 429 call implicitAsyncContig(x) 430 end 431 subroutine test17block(x) 432 real, intent(in out) :: x(:) 433 call explicitAsyncContig(x) ! ok 434 call implicitAsyncContig(x) ! ok 435 block 436 read(1,id=id,asynchronous="yes") x 437 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 438 call explicitAsyncContig(x) 439 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 440 call implicitAsyncContig(x) 441 end block 442 end 443 subroutine test17internal(x) 444 real, intent(in out) :: x(:) 445 call explicitAsyncContig(x) ! ok 446 call implicitAsyncContig(x) ! ok 447 contains 448 subroutine internal 449 read(1,id=id,asynchronous="yes") x 450 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 451 call explicitAsyncContig(x) 452 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE dummy argument 'x=' 453 call implicitAsyncContig(x) 454 end 455 end 456 457end module 458