1! RUN: %python %S/test_errors.py %s %flang_fc1 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 !WARN: Actual argument expression length '0' is less than expected length '2' 169 call ch2("") 170 call pdtdefault(vardefault) 171 call pdtdefault(var3) 172 call pdtdefault(var4) ! error 173 call pdt3(vardefault) ! error 174 !ERROR: Actual argument type 'pdt(n=3_4)' is not compatible with dummy argument type 'pdt(n=4_4)' 175 call pdt3(var3) ! error 176 call pdt3(var4) 177 call pdt4(vardefault) 178 call pdt4(var3) 179 call pdt4(var4) 180 call pdtWithDefaultdefault(defaultVardefault) 181 call pdtWithDefaultdefault(defaultVar3) 182 !ERROR: Actual argument type 'pdtwithdefault(n=4_4)' is not compatible with dummy argument type 'pdtwithdefault(n=3_4)' 183 call pdtWithDefaultdefault(defaultVar4) ! error 184 !ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)' 185 call pdtWithDefault3(defaultVardefault) ! error 186 !ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)' 187 call pdtWithDefault3(defaultVar3) ! error 188 call pdtWithDefault3(defaultVar4) 189 call pdtWithDefault4(defaultVardefault) 190 call pdtWithDefault4(defaultVar3) 191 call pdtWithDefault4(defaultVar4) 192 end subroutine 193 194 subroutine out01(x) 195 type(alloc) :: x 196 end subroutine 197 subroutine test07(x) ! 15.5.2.4(6) 198 type(alloc) :: x[*] 199 !ERROR: Coindexed actual argument with ALLOCATABLE ultimate component '%a' must be associated with a dummy argument 'x=' with VALUE or INTENT(IN) attributes 200 call out01(x[1]) 201 end subroutine 202 203 subroutine test08(x) ! 15.5.2.4(13) 204 real :: x(1)[*] 205 !ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument 'x=' 206 call assumedsize(x(1)[1]) 207 end subroutine 208 209 subroutine charray(x) 210 character :: x(10) 211 end subroutine 212 subroutine test09(ashape, polyarray, c, assumed_shape_char) ! 15.5.2.4(14), 15.5.2.11 213 real :: x, arr(10) 214 real, pointer :: p(:) 215 real, pointer :: p_scalar 216 character(10), pointer :: char_pointer(:) 217 character(*) :: assumed_shape_char(:) 218 real :: ashape(:) 219 class(t) :: polyarray(*) 220 character(10) :: c(:) 221 !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array 222 call assumedsize(x) 223 !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array 224 call assumedsize(p_scalar) 225 !ERROR: Element of pointer array may not be associated with a dummy argument 'x=' array 226 call assumedsize(p(1)) 227 !ERROR: Element of assumed-shape array may not be associated with a dummy argument 'x=' array 228 call assumedsize(ashape(1)) 229 !ERROR: Polymorphic scalar may not be associated with a dummy argument 'x=' array 230 call polyassumedsize(polyarray(1)) 231 call charray(c(1:1)) ! not an error if character 232 call charray(char_pointer(1)) ! not an error if character 233 call charray(assumed_shape_char(1)) ! not an error if character 234 call assumedsize(arr(1)) ! not an error if element in sequence 235 call assumedrank(x) ! not an error 236 call assumedtypeandsize(x) ! not an error 237 end subroutine 238 239 subroutine test10(a) ! 15.5.2.4(16) 240 real :: scalar, matrix(2,3) 241 real :: a(*) 242 !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'x=' 243 call assumedshape(scalar) 244 call assumedshape(reshape(matrix,shape=[size(matrix)])) ! ok 245 !ERROR: Rank of dummy argument is 1, but actual argument has rank 2 246 call assumedshape(matrix) 247 !ERROR: Assumed-size array may not be associated with assumed-shape dummy argument 'x=' 248 call assumedshape(a) 249 end subroutine 250 251 subroutine test11(in) ! C15.5.2.4(20) 252 real, intent(in) :: in 253 real :: x 254 x = 0. 255 !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable 256 call intentout(in) 257 !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable 258 call intentout(3.14159) 259 !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable 260 call intentout(in + 1.) 261 call intentout(x) ! ok 262 !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable 263 call intentout((x)) 264 !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' must be definable 265 call system_clock(count=2) 266 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable 267 call intentinout(in) 268 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable 269 call intentinout(3.14159) 270 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable 271 call intentinout(in + 1.) 272 call intentinout(x) ! ok 273 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable 274 call intentinout((x)) 275 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' must be definable 276 call execute_command_line(command="echo hello", exitstat=0) 277 end subroutine 278 279 subroutine test12 ! 15.5.2.4(21) 280 real :: a(1) 281 integer :: j(1) 282 j(1) = 1 283 !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable 284 call intentout_arr(a(j)) 285 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable 286 call intentinout_arr(a(j)) 287 !ERROR: Actual argument associated with ASYNCHRONOUS dummy argument 'x=' must be definable 288 call asynchronous_arr(a(j)) 289 !ERROR: Actual argument associated with VOLATILE dummy argument 'x=' must be definable 290 call volatile_arr(a(j)) 291 end subroutine 292 293 subroutine coarr(x) 294 type(ultimateCoarray):: x 295 end subroutine 296 subroutine volcoarr(x) 297 type(ultimateCoarray), volatile :: x 298 end subroutine 299 subroutine test13(a, b) ! 15.5.2.4(22) 300 type(ultimateCoarray) :: a 301 type(ultimateCoarray), volatile :: b 302 call coarr(a) ! ok 303 call volcoarr(b) ! ok 304 !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a' 305 call coarr(b) 306 !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a' 307 call volcoarr(a) 308 end subroutine 309 310 subroutine test14(a,b,c,d) ! C1538 311 real :: a[*] 312 real, asynchronous :: b[*] 313 real, volatile :: c[*] 314 real, asynchronous, volatile :: d[*] 315 call asynchronous(a[1]) ! ok 316 call volatile(a[1]) ! ok 317 call asynchronousValue(b[1]) ! ok 318 call asynchronousValue(c[1]) ! ok 319 call asynchronousValue(d[1]) ! ok 320 !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE 321 call asynchronous(b[1]) 322 !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE 323 call volatile(b[1]) 324 !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE 325 call asynchronous(c[1]) 326 !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE 327 call volatile(c[1]) 328 !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE 329 call asynchronous(d[1]) 330 !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE 331 call volatile(d[1]) 332 end subroutine 333 334 subroutine test15() ! C1539 335 real, pointer :: a(:) 336 real, asynchronous :: b(10) 337 real, volatile :: c(10) 338 real, asynchronous, volatile :: d(10) 339 call assumedsize(a(::2)) ! ok 340 call contiguous(a(::2)) ! ok 341 call valueassumedsize(a(::2)) ! ok 342 call valueassumedsize(b(::2)) ! ok 343 call valueassumedsize(c(::2)) ! ok 344 call valueassumedsize(d(::2)) ! ok 345 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' 346 call volatileassumedsize(b(::2)) 347 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' 348 call volatilecontiguous(b(::2)) 349 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' 350 call volatileassumedsize(c(::2)) 351 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' 352 call volatilecontiguous(c(::2)) 353 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' 354 call volatileassumedsize(d(::2)) 355 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' 356 call volatilecontiguous(d(::2)) 357 end subroutine 358 359 subroutine test16() ! C1540 360 real, pointer :: a(:) 361 real, asynchronous, pointer :: b(:) 362 real, volatile, pointer :: c(:) 363 real, asynchronous, volatile, pointer :: d(:) 364 call assumedsize(a) ! ok 365 call contiguous(a) ! ok 366 call pointer(a) ! ok 367 call pointer(b) ! ok 368 call pointer(c) ! ok 369 call pointer(d) ! ok 370 call valueassumedsize(a) ! ok 371 call valueassumedsize(b) ! ok 372 call valueassumedsize(c) ! ok 373 call valueassumedsize(d) ! ok 374 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' 375 call volatileassumedsize(b) 376 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' 377 call volatilecontiguous(b) 378 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' 379 call volatileassumedsize(c) 380 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' 381 call volatilecontiguous(c) 382 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' 383 call volatileassumedsize(d) 384 !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' 385 call volatilecontiguous(d) 386 end subroutine 387 388end module 389