1! PR 101334 2! PR 101337 3! { dg-do compile} 4! { dg-additional-options "-fcoarray=single" } 5! 6! TS 29113 7! C535b An assumed-rank variable name shall not appear in a designator 8! or expression except as an actual argument corresponding to a dummy 9! argument that is assumed-rank, the argument of the C_LOC function 10! in the ISO_C_BINDING intrinsic module, or the first argument in a 11! reference to an intrinsic inquiry function. 12! 13! This has been renamed C838 in the Fortran 2018 standard, with C_SIZEOF 14! and SELECT_RANK additionally added. 15! 16! This test file contains tests that are expected to issue diagnostics 17! for invalid code. 18 19! Check that passing an assumed-rank variable as an actual argument 20! corresponding to a non-assumed-rank dummy gives a diagnostic. 21 22module m 23 interface 24 subroutine f (a, b) 25 implicit none 26 integer :: a 27 integer :: b 28 end subroutine 29 subroutine g (a, b) 30 implicit none 31 integer :: a(..) 32 integer :: b(..) 33 end subroutine 34 subroutine h (a, b) 35 implicit none 36 integer :: a(*) 37 integer :: b(*) 38 end subroutine 39 subroutine i (a, b) 40 implicit none 41 integer :: a(:) 42 integer :: b(:) 43 end subroutine 44 subroutine j (a, b) 45 implicit none 46 integer :: a(3,3) 47 integer :: b(3,3) 48 end subroutine 49 end interface 50end module 51 52subroutine test_calls (x, y) 53 use m 54 implicit none 55 integer :: x(..), y(..) 56 57 ! Make sure each invalid argument produces a diagnostic. 58 ! scalar dummies 59 call f (x, & ! { dg-error "(A|a)ssumed.rank" } 60 y) ! { dg-error "(A|a)ssumed.rank" "pr101337" } 61 ! assumed-rank dummies 62 call g (x, y) ! OK 63 ! assumed-size dummies 64 call h (x, & ! { dg-error "(A|a)ssumed.rank" "pr101334" } 65 y) ! { dg-error "(A|a)ssumed.rank" "pr101337" } 66 ! assumed-shape dummies 67 call i (x, & ! { dg-error "(A|a)ssumed.rank" } 68 y) ! { dg-error "(A|a)ssumed.rank" "pr101337" } 69 ! fixed-size array dummies 70 call j (x, & ! { dg-error "(A|a)ssumed.rank" "pr101334" } 71 y) ! { dg-error "(A|a)ssumed.rank" "pr101337" } 72end subroutine 73 74! Check that you can't use an assumed-rank array variable in an array 75! element or section designator. 76 77subroutine test_designators (x) 78 use m 79 implicit none 80 integer :: x(..) 81 82 call f (x(1), 1) ! { dg-error "(A|a)ssumed.rank" } 83 call g (x(1:3:1), & ! { dg-error "(A|a)ssumed.rank" } 84 x) 85end subroutine 86 87! Check that you can't use an assumed-rank array variable in elemental 88! expressions. Make sure binary operators produce the error for either or 89! both operands. 90 91subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j) 92 implicit none 93 integer :: a(..), b(..), c(..) 94 logical :: l(..), m(..), n(..) 95 integer :: x(s), y(s), z(s) 96 logical :: p(s), q(s), r(s) 97 integer :: s 98 integer :: i 99 logical :: j 100 101 ! Assignment 102 103 z = x ! OK 104 c & ! { dg-error "(A|a)ssumed.rank" } 105 = a ! { dg-error "(A|a)ssumed.rank" } 106 z = i ! OK 107 c = i ! { dg-error "(A|a)ssumed.rank" } 108 109 r = p ! OK 110 n & ! { dg-error "(A|a)ssumed.rank" } 111 = l ! { dg-error "(A|a)ssumed.rank" } 112 r = j ! OK 113 n = j ! { dg-error "(A|a)ssumed.rank" } 114 115 ! Arithmetic 116 117 z = -x ! OK 118 c & ! { dg-error "(A|a)ssumed.rank" } 119 = -a ! { dg-error "(A|a)ssumed.rank" } 120 z = -i ! OK 121 c = -i ! { dg-error "(A|a)ssumed.rank" } 122 123 z = x + y ! OK 124 c & ! { dg-error "(A|a)ssumed.rank" } 125 = a & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 126 + b ! { dg-error "(A|a)ssumed.rank" } 127 z = x + i ! OK 128 c & ! { dg-error "(A|a)ssumed.rank" } 129 = a + i ! { dg-error "(A|a)ssumed.rank" } 130 z = i + y ! OK 131 c & ! { dg-error "(A|a)ssumed.rank" } 132 = i + b ! { dg-error "(A|a)ssumed.rank" } 133 134 z = x - y ! OK 135 c & ! { dg-error "(A|a)ssumed.rank" } 136 = a & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 137 - b ! { dg-error "(A|a)ssumed.rank" } 138 z = x - i ! OK 139 c & ! { dg-error "(A|a)ssumed.rank" } 140 = a - i ! { dg-error "(A|a)ssumed.rank" } 141 z = i - y ! OK 142 c & ! { dg-error "(A|a)ssumed.rank" } 143 = i - b ! { dg-error "(A|a)ssumed.rank" } 144 145 z = x * y ! OK 146 c & ! { dg-error "(A|a)ssumed.rank" } 147 = a & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 148 * b ! { dg-error "(A|a)ssumed.rank" } 149 z = x * i ! OK 150 c & ! { dg-error "(A|a)ssumed.rank" } 151 = a * i ! { dg-error "(A|a)ssumed.rank" } 152 z = i * y ! OK 153 c & ! { dg-error "(A|a)ssumed.rank" } 154 = i * b ! { dg-error "(A|a)ssumed.rank" } 155 156 z = x / y ! OK 157 c & ! { dg-error "(A|a)ssumed.rank" } 158 = a & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 159 / b ! { dg-error "(A|a)ssumed.rank" } 160 z = x / i ! OK 161 c & ! { dg-error "(A|a)ssumed.rank" } 162 = a / i ! { dg-error "(A|a)ssumed.rank" } 163 z = i / y ! OK 164 c & ! { dg-error "(A|a)ssumed.rank" } 165 = i / b ! { dg-error "(A|a)ssumed.rank" } 166 167 z = x ** y ! OK 168 c & ! { dg-error "(A|a)ssumed.rank" } 169 = a & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 170 ** b ! { dg-error "(A|a)ssumed.rank" } 171 z = x ** i ! OK 172 c & ! { dg-error "(A|a)ssumed.rank" } 173 = a ** i ! { dg-error "(A|a)ssumed.rank" } 174 z = i ** y ! OK 175 c & ! { dg-error "(A|a)ssumed.rank" } 176 = i ** b ! { dg-error "(A|a)ssumed.rank" } 177 178 ! Comparisons 179 180 r = x .eq. y ! OK 181 n & ! { dg-error "(A|a)ssumed.rank" } 182 = a & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 183 .eq. b ! { dg-error "(A|a)ssumed.rank" } 184 r = x .eq. i ! OK 185 n & ! { dg-error "(A|a)ssumed.rank" } 186 = a .eq. i ! { dg-error "(A|a)ssumed.rank" } 187 r = i .eq. y ! OK 188 n & ! { dg-error "(A|a)ssumed.rank" } 189 = i .eq. b ! { dg-error "(A|a)ssumed.rank" } 190 191 r = x .ne. y ! OK 192 n & ! { dg-error "(A|a)ssumed.rank" } 193 = a & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 194 .ne. b ! { dg-error "(A|a)ssumed.rank" } 195 r = x .ne. i ! OK 196 n & ! { dg-error "(A|a)ssumed.rank" } 197 = a .ne. i ! { dg-error "(A|a)ssumed.rank" } 198 r = i .ne. y ! OK 199 n & ! { dg-error "(A|a)ssumed.rank" } 200 = i .ne. b ! { dg-error "(A|a)ssumed.rank" } 201 202 r = x .lt. y ! OK 203 n & ! { dg-error "(A|a)ssumed.rank" } 204 = a & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 205 .lt. b ! { dg-error "(A|a)ssumed.rank" } 206 r = x .lt. i ! OK 207 n & ! { dg-error "(A|a)ssumed.rank" } 208 = a .lt. i ! { dg-error "(A|a)ssumed.rank" } 209 r = i .lt. y ! OK 210 n & ! { dg-error "(A|a)ssumed.rank" } 211 = i .lt. b ! { dg-error "(A|a)ssumed.rank" } 212 213 r = x .le. y ! OK 214 n & ! { dg-error "(A|a)ssumed.rank" } 215 = a & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 216 .le. b ! { dg-error "(A|a)ssumed.rank" } 217 r = x .le. i ! OK 218 n & ! { dg-error "(A|a)ssumed.rank" } 219 = a .le. i ! { dg-error "(A|a)ssumed.rank" } 220 r = i .le. y ! OK 221 n & ! { dg-error "(A|a)ssumed.rank" } 222 = i .le. b ! { dg-error "(A|a)ssumed.rank" } 223 224 r = x .gt. y ! OK 225 n & ! { dg-error "(A|a)ssumed.rank" } 226 = a & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 227 .gt. b ! { dg-error "(A|a)ssumed.rank" } 228 r = x .gt. i ! OK 229 n & ! { dg-error "(A|a)ssumed.rank" } 230 = a .gt. i ! { dg-error "(A|a)ssumed.rank" } 231 r = i .gt. y ! OK 232 n & ! { dg-error "(A|a)ssumed.rank" } 233 = i .gt. b ! { dg-error "(A|a)ssumed.rank" } 234 235 r = x .ge. y ! OK 236 n & ! { dg-error "(A|a)ssumed.rank" } 237 = a & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 238 .ge. b ! { dg-error "(A|a)ssumed.rank" } 239 r = x .ge. i ! OK 240 n & ! { dg-error "(A|a)ssumed.rank" } 241 = a .ge. i ! { dg-error "(A|a)ssumed.rank" } 242 r = i .ge. y ! OK 243 n & ! { dg-error "(A|a)ssumed.rank" } 244 = i .ge. b ! { dg-error "(A|a)ssumed.rank" } 245 246 ! Logical operators 247 248 r = .not. p ! OK 249 n & ! { dg-error "(A|a)ssumed.rank" } 250 = .not. l ! { dg-error "(A|a)ssumed.rank" } 251 r = .not. j ! OK 252 n = .not. j ! { dg-error "(A|a)ssumed.rank" } 253 254 r = p .and. q ! OK 255 n & ! { dg-error "(A|a)ssumed.rank" } 256 = l & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 257 .and. m ! { dg-error "(A|a)ssumed.rank" } 258 r = p .and. j ! OK 259 n & ! { dg-error "(A|a)ssumed.rank" } 260 = l .and. j ! { dg-error "(A|a)ssumed.rank" } 261 r = j .and. q ! OK 262 n & ! { dg-error "(A|a)ssumed.rank" } 263 = j .and. m ! { dg-error "(A|a)ssumed.rank" } 264 265 r = p .or. q ! OK 266 n & ! { dg-error "(A|a)ssumed.rank" } 267 = l & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 268 .or. m ! { dg-error "(A|a)ssumed.rank" } 269 r = p .or. j ! OK 270 n & ! { dg-error "(A|a)ssumed.rank" } 271 = l .or. j ! { dg-error "(A|a)ssumed.rank" } 272 r = j .or. q ! OK 273 n & ! { dg-error "(A|a)ssumed.rank" } 274 = j .or. m ! { dg-error "(A|a)ssumed.rank" } 275 276 r = p .eqv. q ! OK 277 n & ! { dg-error "(A|a)ssumed.rank" } 278 = l & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 279 .eqv. m ! { dg-error "(A|a)ssumed.rank" } 280 r = p .eqv. j ! OK 281 n & ! { dg-error "(A|a)ssumed.rank" } 282 = l .eqv. j ! { dg-error "(A|a)ssumed.rank" } 283 r = j .eqv. q ! OK 284 n & ! { dg-error "(A|a)ssumed.rank" } 285 = j .eqv. m ! { dg-error "(A|a)ssumed.rank" } 286 287 r = p .neqv. q ! OK 288 n & ! { dg-error "(A|a)ssumed.rank" } 289 = l & ! { dg-error "(A|a)ssumed.rank" "pr101337" } 290 .neqv. m ! { dg-error "(A|a)ssumed.rank" } 291 r = p .neqv. j ! OK 292 n & ! { dg-error "(A|a)ssumed.rank" } 293 = l .neqv. j ! { dg-error "(A|a)ssumed.rank" } 294 r = j .neqv. q ! OK 295 n & ! { dg-error "(A|a)ssumed.rank" } 296 = j .neqv. m ! { dg-error "(A|a)ssumed.rank" } 297 298end subroutine 299 300! Check that calls to disallowed intrinsic functions produce a diagnostic. 301! There are 100+ "elemental" intrinsics defined in the standard, and 302! 25+ "transformational" intrinsics that accept array operands, and that 303! doesn't include intrinsics in the standard modules. To keep the length of 304! this test to something sane, check only a handful of these functions on 305! the theory that related functions are probably implemented similarly and 306! probably share the same argument-processing code. 307 308subroutine test_intrinsics (i1, i2, r1, r2, c1, c2, l1, l2, s1, s2) 309 implicit none 310 integer :: i1(..), i2(..) 311 real :: r1(..), r2(..) 312 complex :: c1(..), c2(..) 313 logical :: l1(..), l2(..) 314 character :: s1(..), s2(..) 315 316 integer :: i 317 real :: r 318 logical :: l 319 320 ! trig, hyperbolic, other math functions 321 r1 & ! { dg-error "(A|a)ssumed.rank" } 322 = atan2 (r1, & ! { dg-error "(A|a)ssumed.rank" } 323 r2) ! { dg-error "(A|a)ssumed.rank" "pr101337" } 324 r1 & ! { dg-error "(A|a)ssumed.rank" } 325 = atan (r2) ! { dg-error "(A|a)ssumed.rank" } 326 c1 & ! { dg-error "(A|a)ssumed.rank" } 327 = atan (c2) ! { dg-error "(A|a)ssumed.rank" } 328 r1 & ! { dg-error "(A|a)ssumed.rank" } 329 = cos (r2) ! { dg-error "(A|a)ssumed.rank" } 330 r1 & ! { dg-error "(A|a)ssumed.rank" } 331 = exp (r2) ! { dg-error "(A|a)ssumed.rank" } 332 r1 & ! { dg-error "(A|a)ssumed.rank" } 333 = sinh (r2) ! { dg-error "(A|a)ssumed.rank" } 334 335 ! bit operations 336 l1 & ! { dg-error "(A|a)ssumed.rank" } 337 = blt (i1, & ! { dg-error "(A|a)ssumed.rank" } 338 i2) ! { dg-error "(A|a)ssumed.rank" "pr101337" } 339 l1 & ! { dg-error "(A|a)ssumed.rank" } 340 = btest (i1, 0) ! { dg-error "(A|a)ssumed.rank" } 341 i1 & ! { dg-error "(A|a)ssumed.rank" } 342 = not (i2) ! { dg-error "(A|a)ssumed.rank" } 343 i1 & ! { dg-error "(A|a)ssumed.rank" } 344 = popcnt (i2) ! { dg-error "(A|a)ssumed.rank" } 345 346 ! type conversions 347 s1 & ! { dg-error "(A|a)ssumed.rank" } 348 = char (i1) ! { dg-error "(A|a)ssumed.rank" } 349 c1 & ! { dg-error "(A|a)ssumed.rank" } 350 = cmplx (r1, & ! { dg-error "(A|a)ssumed.rank" } 351 r2) ! { dg-error "(A|a)ssumed.rank" "pr101337" } 352 i1 & ! { dg-error "(A|a)ssumed.rank" } 353 = floor (r1) ! { dg-error "(A|a)ssumed.rank" } 354 r1 & ! { dg-error "(A|a)ssumed.rank" } 355 = real (c1) ! { dg-error "(A|a)ssumed.rank" } 356 357 ! reductions 358 l = any (l2) ! { dg-error "(A|a)ssumed.rank" } 359 r = dot_product (r1, & ! { dg-error "(A|a)ssumed.rank" } 360 r2) ! { dg-error "(A|a)ssumed.rank" "pr101337" } 361 i = iall (i2, & ! { dg-error "(A|a)ssumed.rank" } 362 l2) ! { dg-error "(A|a)ssumed.rank" "pr101337" } 363 364 ! string operations 365 s1 & ! { dg-error "(A|a)ssumed.rank" } 366 = adjustr (s2) ! { dg-error "(A|a)ssumed.rank" } 367 i1 & ! { dg-error "(A|a)ssumed.rank" } 368 = index (c1, & ! { dg-error "(A|a)ssumed.rank" } 369 c2) ! { dg-error "(A|a)ssumed.rank" "pr101337" } 370 371 ! misc 372 i1 & ! { dg-error "(A|a)ssumed.rank" } 373 = cshift (i2, 4) ! { dg-error "(A|a)ssumed.rank" } 374 i = findloc (r1, 0.0) ! { dg-error "(A|a)ssumed.rank" } 375 r1 & ! { dg-error "(A|a)ssumed.rank" } 376 = matmul (r1, & ! { dg-error "(A|a)ssumed.rank" } 377 r2) ! { dg-error "(A|a)ssumed.rank" "pr101337" } 378 r1 & ! { dg-error "(A|a)ssumed.rank" } 379 = reshape (r2, [10, 3]) ! { dg-error "(A|a)ssumed.rank" } 380 i1 & ! { dg-error "(A|a)ssumed.rank" } 381 = sign (i1, & ! { dg-error "(A|a)ssumed.rank" } 382 i2) ! { dg-error "(A|a)ssumed.rank" "pr101337" } 383 s1 & ! { dg-error "(A|a)ssumed.rank" } 384 = transpose (s2) ! { dg-error "(A|a)ssumed.rank" } 385 386end subroutine 387