libgomp/testsuite/libgomp.fortran/non-rectangular-loop-2.f90

   1 ! { dg-do run }
   2 ! { dg-additional-options "-fdump-tree-original -fcheck=all" }
   3
   4 ! PR fortran/107424
   5
   6 ! Nonrectangular loop nests checks
   7
   8 ! Valid patterns are:
   9 !  (1)  a2 - var-outer
  10 !  (2)  a1 * var-outer
  11 !  (3)  a1 * var-outer + a2
  12 !  (4)  a2 + a1 * var-outer
  13 !  (5)  a1 * var-outer - a2
  14 !  (6)  a2 - a1 * var-outer
  15 !  (7)  var-outer * a1
  16 !  (8)  var-outer * a1 + a2
  17 !  (9)  a2 + var-outer * a1
  18 ! (10)  var-outer * a1 - a2
  19 ! (11)  a2 - var-outer * a1
  20
  21 module m
  22 contains
  23
  24
  25 ! { dg-final { scan-tree-dump-times "for \\(one_two_inner = one_two_outer \\* -1 \\+ one_a2; one_two_inner <= one_two_outer \\* two_a1 \\+ 0; one_two_inner = one_two_inner \\+ 1\\)" 1 original } }
  26
  27 !  (1)  a2 - var-outer
  28 !  (2)  a1 * var-outer
  29 subroutine one_two()
  30   implicit none
  31   integer :: one_a2
  32   integer :: two_a1
  33   integer :: one_two_outer, one_two_inner
  34   integer :: i, j
  35   integer, allocatable :: var(:,:)
  36
  37   one_a2 = 13
  38   two_a1 = 5
  39   allocate(var(1:10, one_a2 - 10:two_a1 * 10), &
  40            source=0)
  41   if (size(var) <= 4) error stop
  42
  43   !$omp simd collapse(2)
  44   do one_two_outer = 1, 10
  45     do one_two_inner = one_a2 - one_two_outer, two_a1 * one_two_outer
  46       !$omp atomic update
  47       var(one_two_outer,one_two_inner) = var(one_two_outer,one_two_inner) + 2
  48     end do
  49   end do
  50
  51   do i = 1, 10
  52     do j = one_a2 - i, two_a1 * i
  53       if (var(i,j) /= 2) error stop
  54     end do
  55   end do
  56 end
  57
  58
  59 ! { dg-final { scan-tree-dump-times "for \\(three_four_inner = three_four_outer \\* three_a1 \\+ three_a2; three_four_inner <= three_four_outer \\* four_a1 \\+ four_a2; three_four_inner = three_four_inner \\+ 1\\)" 1 original } }
  60
  61 !  (3)  a1 * var-outer + a2
  62 !  (4)  a2 + a1 * var-outer
  63 subroutine three_four()
  64   implicit none
  65   integer :: three_a1, three_a2
  66   integer :: four_a1, four_a2
  67   integer :: three_four_outer, three_four_inner
  68   integer :: i, j
  69   integer, allocatable :: var(:,:)
  70
  71   three_a1 = 2
  72   three_a2 = 3
  73   four_a1 = 3
  74   four_a2 = 5
  75   allocate(var(1:10, three_a1 * 1 + three_a2:four_a2 + four_a1 * 10), &
  76            source=0)
  77   if (size(var) <= 4) error stop
  78
  79   !$omp simd collapse(2)
  80   do three_four_outer = 1, 10
  81     do three_four_inner = three_a1 * three_four_outer + three_a2, four_a2 + four_a1 * three_four_outer
  82       !$omp atomic update
  83       var(three_four_outer, three_four_inner) = var(three_four_outer, three_four_inner) + 2
  84     end do
  85   end do
  86   do i = 1, 10
  87     do j = three_a1 * i + three_a2, four_a2 + four_a1 * i
  88       if (var(i,j) /= 2) error stop
  89     end do
  90   end do
  91 end
  92
  93
  94 ! { dg-final { scan-tree-dump-times "for \\(five_six_inner = five_six_outer \\* five_a1 \\+ D\\.\[0-9\]+; five_six_inner <= five_six_outer \\* D\\.\[0-9\]+ \\+ six_a2; five_six_inner = five_six_inner \\+ 1\\)" 1 original } }
  95
  96 !  (5)  a1 * var-outer - a2
  97 !  (6)  a2 - a1 * var-outer
  98 subroutine five_six()
  99   implicit none
 100   integer :: five_a1, five_a2
 101   integer :: six_a1, six_a2
 102   integer :: five_six_outer, five_six_inner
 103   integer :: i, j
 104   integer, allocatable :: var(:,:)
 105
 106   five_a1 = 2
 107   five_a2 = -3
 108   six_a1 = 3
 109   six_a2 = 20
 110   allocate(var(1:10, five_a1 * 1 - five_a2:six_a2 - six_a1 * 1), &
 111            source=0)
 112   if (size(var) <= 4) error stop
 113
 114   !$omp simd collapse(2)
 115   do five_six_outer = 1, 10
 116     do five_six_inner = five_a1 * five_six_outer - five_a2, six_a2 - six_a1 * five_six_outer
 117       !$omp atomic update
 118       var(five_six_outer, five_six_inner) = var(five_six_outer, five_six_inner) + 2
 119     end do
 120   end do
 121
 122   do i = 1, 10
 123     do j = five_a1 * i - five_a2, six_a2 - six_a1 * i
 124       if (var(i,j) /= 2) error stop
 125     end do
 126   end do
 127 end
 128
 129
 130 ! { dg-final { scan-tree-dump-times "for \\(seven_eight_inner = seven_eight_outer \\* seven_a1 \\+ 0; seven_eight_inner <= seven_eight_outer \\* eight_a1 \\+ eight_a2; seven_eight_inner = seven_eight_inner \\+ 1\\)" 1 original } }
 131
 132 !  (7)  var-outer * a1
 133 !  (8)  var-outer * a1 + a2
 134 subroutine seven_eight()
 135   implicit none
 136   integer :: seven_a1
 137   integer :: eight_a1, eight_a2
 138   integer :: seven_eight_outer, seven_eight_inner
 139   integer :: i, j
 140   integer, allocatable :: var(:,:)
 141
 142   seven_a1 = 3
 143   eight_a1 = 2
 144   eight_a2 = -4
 145   allocate(var(1:10, 1 * seven_a1 : 10 * eight_a1 + eight_a2), &
 146            source=0)
 147   if (size(var) <= 4) error stop
 148
 149   !$omp simd collapse(2)
 150   do seven_eight_outer = 1, 10
 151     do seven_eight_inner = seven_eight_outer * seven_a1, seven_eight_outer * eight_a1 + eight_a2
 152       !$omp atomic update
 153       var(seven_eight_outer, seven_eight_inner) = var(seven_eight_outer, seven_eight_inner) + 2
 154     end do
 155   end do
 156
 157   do i = 1, 10
 158     do j = i * seven_a1, i * eight_a1 + eight_a2
 159       if (var(i,j) /= 2) error stop
 160     end do
 161   end do
 162 end
 163
 164
 165 ! { dg-final { scan-tree-dump-times "for \\(nine_ten_inner = nine_ten_outer \\* nine_a1 \\+ nine_a2; nine_ten_inner <= nine_ten_outer \\* ten_a1 \\+ D\\.\[0-9\]+; nine_ten_inner = nine_ten_inner \\+ 1\\)" 1 original } }
 166
 167 !  (9)  a2 + var-outer * a1
 168 ! (10)  var-outer * a1 - a2
 169 subroutine nine_ten()
 170   implicit none
 171   integer :: nine_a1, nine_a2
 172   integer :: ten_a1, ten_a2
 173   integer :: nine_ten_outer, nine_ten_inner
 174   integer :: i, j
 175   integer, allocatable :: var(:,:)
 176
 177   nine_a1 = 3
 178   nine_a2 = 5
 179   ten_a1 = 2
 180   ten_a2 = 3
 181   allocate(var(1:10, nine_a2 + 1 * nine_a1:10 * ten_a1 - ten_a2), &
 182            source=0)
 183   if (size(var) <= 4) error stop
 184
 185   !$omp simd collapse(2)
 186   do nine_ten_outer = 1, 10
 187     do nine_ten_inner = nine_a2 + nine_ten_outer * nine_a1, nine_ten_outer * ten_a1 - ten_a2
 188       !$omp atomic update
 189       var(nine_ten_outer, nine_ten_inner) = var(nine_ten_outer, nine_ten_inner) + 2
 190     end do
 191   end do
 192
 193   do i = 1, 10
 194     do j = nine_a2 + i * nine_a1, i * ten_a1 - ten_a2
 195       if (var(i,j) /= 2) error stop
 196     end do
 197   end do
 198 end
 199
 200
 201 ! { dg-final { scan-tree-dump-times "for \\(eleven_inner = eleven_outer \\* D\\.\[0-9\]+ \\+ eleven_a2; eleven_inner <= 10; eleven_inner = eleven_inner \\+ 1\\)" 1 original } }
 202
 203 ! (11)  a2 - var-outer * a1
 204
 205 subroutine eleven()
 206   implicit none
 207   integer :: eleven_a1, eleven_a2
 208   integer :: eleven_outer, eleven_inner
 209   integer :: i, j
 210   integer, allocatable :: var(:,:)
 211
 212   eleven_a1 = 2
 213   eleven_a2 = 3
 214   allocate(var(1:10, eleven_a2 - 10 * eleven_a1 : 10), &
 215            source=0)
 216   if (size(var) <= 4) error stop
 217
 218   !$omp simd collapse(2)
 219   do eleven_outer = 1, 10
 220     do eleven_inner = eleven_a2 - eleven_outer * eleven_a1, 10
 221       !$omp atomic update
 222       var(eleven_outer, eleven_inner) = var(eleven_outer, eleven_inner) + 2
 223     end do
 224   end do
 225
 226   do i = 1, 10
 227     do j = eleven_a2 - i * eleven_a1, 10
 228       if (var(i,j) /= 2) error stop
 229     end do
 230   end do
 231 end
 232 end module m
 233
 234 program main
 235 use m
 236 implicit none
 237 call one_two()
 238 call three_four()
 239 call five_six()
 240 call seven_eight()
 241 call nine_ten()
 242 call eleven()
 243 end