gcc/testsuite/gfortran.dg/gomp/udr8.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fmax-errors=1000 -fopenmp" }
   3
   4 module m
   5 contains
   6   function fn1 (x, y)
   7     integer, intent(in) :: x, y
   8     integer :: fn1
   9     fn1 = x + 2 * y
  10   end function
  11   subroutine sub1 (x, y)
  12     integer, intent(in) :: y
  13     integer, intent(out) :: x
  14     x = y
  15   end subroutine
  16   function fn2 (x)
  17     integer, intent(in) :: x
  18     integer :: fn2
  19     fn2 = x
  20   end function
  21   subroutine sub2 (x, y)
  22     integer, intent(in) :: y
  23     integer, intent(inout) :: x
  24     x = x + y
  25   end subroutine
  26   function fn3 (x, y)
  27     integer, intent(in) :: x(:), y(:)
  28     integer :: fn3(lbound(x, 1):ubound(x, 1))
  29     fn3 = x + 2 * y
  30   end function
  31   subroutine sub3 (x, y)
  32     integer, intent(in) :: y(:)
  33     integer, intent(out) :: x(:)
  34     x = y
  35   end subroutine
  36   function fn4 (x)
  37     integer, intent(in) :: x(:)
  38     integer :: fn4(lbound(x, 1):ubound(x, 1))
  39     fn4 = x
  40   end function
  41   subroutine sub4 (x, y)
  42     integer, intent(in) :: y(:)
  43     integer, intent(inout) :: x(:)
  44     x = x + y
  45   end subroutine
  46   function fn5 (x, y)
  47     integer, intent(in) :: x(10), y(10)
  48     integer :: fn5(10)
  49     fn5 = x + 2 * y
  50   end function
  51   subroutine sub5 (x, y)
  52     integer, intent(in) :: y(10)
  53     integer, intent(out) :: x(10)
  54     x = y
  55   end subroutine
  56   function fn6 (x)
  57     integer, intent(in) :: x(10)
  58     integer :: fn6(10)
  59     fn6 = x
  60   end function
  61   subroutine sub6 (x, y)
  62     integer, intent(in) :: y(10)
  63     integer, intent(inout) :: x(10)
  64     x = x + y
  65   end subroutine
  66   function fn7 (x, y)
  67     integer, allocatable, intent(in) :: x(:), y(:)
  68     integer, allocatable :: fn7(:)
  69     fn7 = x + 2 * y
  70   end function
  71   subroutine sub7 (x, y)
  72     integer, allocatable, intent(in) :: y(:)
  73     integer, allocatable, intent(out) :: x(:)
  74     x = y
  75   end subroutine
  76   function fn8 (x)
  77     integer, allocatable, intent(in) :: x(:)
  78     integer, allocatable :: fn8(:)
  79     fn8 = x
  80   end function
  81   subroutine sub8 (x, y)
  82     integer, allocatable, intent(in) :: y(:)
  83     integer, allocatable, intent(inout) :: x(:)
  84     x = x + y
  85   end subroutine
  86 end module
  87 subroutine test1
  88   use m
  89 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
  90 !$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
  91 !$omp & initializer (sub1 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
  92 !$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
  93 !$omp initializer (omp_priv = fn2 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
  94   integer :: a(10)
  95 !$omp parallel reduction (foo : a)
  96 !$omp end parallel
  97 !$omp parallel reduction (bar : a)
  98 !$omp end parallel
  99 !$omp parallel reduction (baz : a)
 100 !$omp end parallel
 101 end subroutine test1
 102 subroutine test2
 103   use m
 104 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 105 !$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) &
 106 !$omp & initializer (sub1 (omp_priv, omp_orig))
 107 !$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) &
 108 !$omp initializer (omp_priv = fn2 (omp_orig))
 109   integer :: a
 110 !$omp parallel reduction (foo : a)
 111 !$omp end parallel
 112 !$omp parallel reduction (bar : a)
 113 !$omp end parallel
 114 !$omp parallel reduction (baz : a)
 115 !$omp end parallel
 116 end subroutine test2
 117 subroutine test3
 118   use m
 119 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 120 !$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
 121 !$omp & initializer (sub1 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
 122 !$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
 123 !$omp initializer (omp_priv = fn2 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
 124   integer, allocatable :: a(:)
 125   allocate (a(10))
 126 !$omp parallel reduction (foo : a)
 127 !$omp end parallel
 128 !$omp parallel reduction (bar : a)
 129 !$omp end parallel
 130 !$omp parallel reduction (baz : a)
 131 !$omp end parallel
 132 end subroutine test3
 133 subroutine test4
 134   use m
 135 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 136 !$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) &
 137 !$omp & initializer (sub1 (omp_priv, omp_orig))
 138 !$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) &
 139 !$omp initializer (omp_priv = fn2 (omp_orig))
 140   integer, allocatable :: a
 141   allocate (a)
 142 !$omp parallel reduction (foo : a)
 143 !$omp end parallel
 144 !$omp parallel reduction (bar : a)
 145 !$omp end parallel
 146 !$omp parallel reduction (baz : a)
 147 !$omp end parallel
 148 end subroutine test4
 149 subroutine test5
 150   use m
 151 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 152 !$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) &
 153 !$omp & initializer (sub3 (omp_priv, omp_orig))
 154 !$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) &
 155 !$omp initializer (omp_priv = fn4 (omp_orig))
 156   integer :: a(10)
 157 !$omp parallel reduction (foo : a)
 158 !$omp end parallel
 159 !$omp parallel reduction (bar : a)
 160 !$omp end parallel
 161 !$omp parallel reduction (baz : a)
 162 !$omp end parallel
 163 end subroutine test5
 164 subroutine test6
 165   use m
 166 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 167 !$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
 168 !$omp & initializer (sub3 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
 169 !$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
 170 !$omp initializer (omp_priv = fn4 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
 171   integer :: a
 172 !$omp parallel reduction (foo : a)
 173 !$omp end parallel
 174 !$omp parallel reduction (bar : a)
 175 !$omp end parallel
 176 !$omp parallel reduction (baz : a)
 177 !$omp end parallel
 178 end subroutine test6
 179 subroutine test7
 180   use m
 181 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 182 !$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) &
 183 !$omp & initializer (sub3 (omp_priv, omp_orig))
 184 !$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) &
 185 !$omp initializer (omp_priv = fn4 (omp_orig))
 186   integer, allocatable :: a(:)
 187   allocate (a(10))
 188 !$omp parallel reduction (foo : a)
 189 !$omp end parallel
 190 !$omp parallel reduction (bar : a)
 191 !$omp end parallel
 192 !$omp parallel reduction (baz : a)
 193 !$omp end parallel
 194 end subroutine test7
 195 subroutine test8
 196   use m
 197 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 198 !$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
 199 !$omp & initializer (sub3 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
 200 !$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
 201 !$omp initializer (omp_priv = fn4 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
 202   integer, allocatable :: a
 203   allocate (a)
 204 !$omp parallel reduction (foo : a)
 205 !$omp end parallel
 206 !$omp parallel reduction (bar : a)
 207 !$omp end parallel
 208 !$omp parallel reduction (baz : a)
 209 !$omp end parallel
 210 end subroutine test8
 211 subroutine test9
 212   use m
 213 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 214 !$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) &
 215 !$omp & initializer (sub5 (omp_priv, omp_orig))
 216 !$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) &
 217 !$omp initializer (omp_priv = fn6 (omp_orig))
 218   integer :: a(10)
 219 !$omp parallel reduction (foo : a)
 220 !$omp end parallel
 221 !$omp parallel reduction (bar : a)
 222 !$omp end parallel
 223 !$omp parallel reduction (baz : a)
 224 !$omp end parallel
 225 end subroutine test9
 226 subroutine test10
 227   use m
 228 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 229 !$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
 230 !$omp & initializer (sub5 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
 231 !$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
 232 !$omp initializer (omp_priv = fn6 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
 233   integer :: a
 234 !$omp parallel reduction (foo : a)
 235 !$omp end parallel
 236 !$omp parallel reduction (bar : a)
 237 !$omp end parallel
 238 !$omp parallel reduction (baz : a)
 239 !$omp end parallel
 240 end subroutine test10
 241 subroutine test11
 242   use m
 243 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 244 !$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) &
 245 !$omp & initializer (sub5 (omp_priv, omp_orig))
 246 !$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) &
 247 !$omp initializer (omp_priv = fn6 (omp_orig))
 248   integer, allocatable :: a(:)
 249   allocate (a(10))
 250 !$omp parallel reduction (foo : a)
 251 !$omp end parallel
 252 !$omp parallel reduction (bar : a)
 253 !$omp end parallel
 254 !$omp parallel reduction (baz : a)
 255 !$omp end parallel
 256 end subroutine test11
 257 subroutine test12
 258   use m
 259 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 260 !$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
 261 !$omp & initializer (sub5 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
 262 !$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
 263 !$omp initializer (omp_priv = fn6 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
 264   integer, allocatable :: a
 265   allocate (a)
 266 !$omp parallel reduction (foo : a)
 267 !$omp end parallel
 268 !$omp parallel reduction (bar : a)
 269 !$omp end parallel
 270 !$omp parallel reduction (baz : a)
 271 !$omp end parallel
 272 end subroutine test12
 273 subroutine test13
 274   use m
 275 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 276 !$omp declare reduction (bar : integer : omp_out = & ! { dg-error "Different shape for array assignment at \[^\n\r]* on dimension 1 .9 and 10" }
 277 !$omp & fn5 (omp_out, omp_in)) & ! { dg-warning "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" }
 278 !$omp & initializer (sub5 (omp_priv, omp_orig)) ! { dg-warning "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" }
 279 !$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & ! { dg-warning "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" }
 280 !$omp initializer (omp_priv = & ! { dg-error "Different shape for array assignment at \[^\n\r]* on dimension 1 .9 and 10" }
 281 !$omp & fn6 (omp_orig)) ! { dg-warning "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" }
 282   integer :: a(9)
 283 !$omp parallel reduction (foo : a)
 284 !$omp end parallel
 285 !$omp parallel reduction (bar : a)
 286 !$omp end parallel
 287 !$omp parallel reduction (baz : a)
 288 !$omp end parallel
 289 end subroutine test13
 290 subroutine test14
 291   use m
 292 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 293 !$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" }
 294 !$omp & initializer (sub7 (omp_priv, omp_orig)) ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" }
 295 !$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" }
 296 !$omp initializer (omp_priv = fn8 (omp_orig)) ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" }
 297   integer :: a(10)
 298 !$omp parallel reduction (foo : a)
 299 !$omp end parallel
 300 !$omp parallel reduction (bar : a)
 301 !$omp end parallel
 302 !$omp parallel reduction (baz : a)
 303 !$omp end parallel
 304 end subroutine test14
 305 subroutine test15
 306   use m
 307 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 308 !$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
 309 !$omp & initializer (sub7 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
 310 !$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
 311 !$omp initializer (omp_priv = fn8 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
 312   integer :: a
 313 !$omp parallel reduction (foo : a)
 314 !$omp end parallel
 315 !$omp parallel reduction (bar : a)
 316 !$omp end parallel
 317 !$omp parallel reduction (baz : a)
 318 !$omp end parallel
 319 end subroutine test15
 320 subroutine test16
 321   use m
 322 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 323 !$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) &
 324 !$omp & initializer (sub7 (omp_priv, omp_orig))
 325 !$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) &
 326 !$omp initializer (omp_priv = fn8 (omp_orig))
 327   integer, allocatable :: a(:)
 328   allocate (a(10))
 329 !$omp parallel reduction (foo : a)
 330 !$omp end parallel
 331 !$omp parallel reduction (bar : a)
 332 !$omp end parallel
 333 !$omp parallel reduction (baz : a)
 334 !$omp end parallel
 335 end subroutine test16
 336 subroutine test17
 337   use m
 338 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
 339 !$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
 340 !$omp & initializer (sub7 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
 341 !$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
 342 !$omp initializer (omp_priv = fn8 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
 343   integer, allocatable :: a
 344   allocate (a)
 345 !$omp parallel reduction (foo : a)
 346 !$omp end parallel
 347 !$omp parallel reduction (bar : a)
 348 !$omp end parallel
 349 !$omp parallel reduction (baz : a)
 350 !$omp end parallel
 351 end subroutine test17