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

   1 ! { dg-additional-options "-fdump-tree-original" }
   2 ! PR fortran/107424
   3
   4 ! Same as non-rectangular-loop-4.f90 but expr in upper bound
   5
   6 module m
   7 contains
   8 subroutine foo (av, avo, a0, a0o, a1, a2, a3, a4)
   9 implicit none
  10
  11 integer, value :: av
  12 integer, value, optional :: avo
  13 integer :: a0
  14 integer, optional :: a0o
  15 integer, pointer :: a1
  16 integer, pointer, optional :: a2
  17 integer, allocatable :: a3
  18 integer, allocatable, optional :: a4
  19 integer :: a5
  20 integer, pointer :: a6
  21 integer, allocatable :: a7
  22 integer :: arr(20,10), ref(20,10)
  23
  24 integer :: j, i, lp_i, lp_j
  25
  26 allocate(a6, a7)
  27
  28 ref = 44
  29 do i = 1, 10
  30   do j = 1, i*2-1
  31     ref(j, i) = j + 100 * i
  32   end do
  33 end do
  34 lp_i = i; lp_j = j
  35
  36 ! { dg-final { scan-tree-dump-times "for \\(av = 1; av <= 10; av = av \\+ 1\\)" 1 "original" } }
  37 ! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= av \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
  38 ! -> no temp var
  39 arr = 44
  40 av = 99; j = 99
  41 !$omp simd collapse(2) lastprivate(av,j)
  42 do av = 1, 10
  43   do j = 1, av*2-1
  44     arr(j, av) = j + 100 * av
  45   end do
  46 end do
  47 if (any (ref /= arr)) error stop
  48 if (av /= lp_i .or. j /= lp_j) error stop
  49
  50 ! { dg-final { scan-tree-dump-times "for \\(avo = 1; avo <= 10; avo = avo \\+ 1\\)" 1 "original" } }
  51 ! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= avo \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
  52 ! -> no temp var
  53 arr = 44
  54 avo = 99; j = 99
  55 !$omp simd collapse(2) lastprivate(avo, j)
  56 do avo = 1, 10
  57   do j = 1, avo*2-1
  58     arr(j, avo) = j + 100 * avo
  59   end do
  60 end do
  61 if (any (ref /= arr)) error stop
  62 if (avo /= lp_i .or. j /= lp_j) error stop
  63
  64 ! { dg-final { scan-tree-dump-times "for \\(a0\\.\[0-9\]+ = 1; a0\\.\[0-9\]+ <= 10; a0\\.\[0-9\]+ = a0\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
  65 ! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a0\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
  66 ! { dg-final { scan-tree-dump-times "\\*a0 = a0\\.\[0-9\]+;" 1 "original" } }
  67 arr = 44
  68 a0 = 99; j = 99
  69 !$omp simd collapse(2) lastprivate(a0,j)
  70 do a0 = 1, 10
  71   do j = 1, a0*2-1
  72     arr(j, a0) = j + 100 * a0
  73   end do
  74 end do
  75 if (any (ref /= arr)) error stop
  76 if (a0 /= lp_i .or. j /= lp_j) error stop
  77
  78 ! { dg-final { scan-tree-dump-times "for \\(a0o\\.\[0-9\]+ = 1; a0o\\.\[0-9\]+ <= 10; a0o\\.\[0-9\]+ = a0o\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
  79 ! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a0o\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
  80 ! { dg-final { scan-tree-dump-times "\\*a0o = a0o\\.\[0-9\]+;" 1 "original" } }
  81 arr = 44
  82 a0o = 99; j = 99
  83 !$omp simd collapse(2) lastprivate(a0o,j)
  84 do a0o = 1, 10
  85   do j = 1, a0o*2-1
  86     arr(j, a0o) = j + 100 * a0o
  87   end do
  88 end do
  89 if (any (ref /= arr)) error stop
  90 if (a0o /= lp_i .or. j /= lp_j) error stop
  91
  92 ! { dg-final { scan-tree-dump-times "for \\(a1\\.\[0-9\]+ = 1; a1\\.\[0-9\]+ <= 10; a1\\.\[0-9\]+ = a1\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
  93 ! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a1\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
  94 ! { dg-final { scan-tree-dump-times "\\*\\*a1 = a1\\.\[0-9\]+;" 1 "original" } }
  95 arr = 44
  96 a1 = 99; j = 99
  97 ! no last private for 'a1' as "The initial status of a private pointer is undefined."
  98 !$omp simd collapse(2) lastprivate(j)
  99 do a1 = 1, 10
 100   do j = 1, a1*2-1
 101     arr(j, a1) = j + 100 * a1
 102   end do
 103 end do
 104 if (any (ref /= arr)) error stop
 105 if (j /= lp_j) error stop
 106
 107 ! { dg-final { scan-tree-dump-times "for \\(a2\\.\[0-9\]+ = 1; a2\\.\[0-9\]+ <= 10; a2\\.\[0-9\]+ = a2\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
 108 ! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a2\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
 109 ! { dg-final { scan-tree-dump-times "\\*\\*a2 = a2\\.\[0-9\]+;" 1 "original" } }
 110 arr = 44
 111 a2 = 99; j = 99
 112 ! no last private for 'a2' as "The initial status of a private pointer is undefined."
 113 !$omp simd collapse(2) lastprivate(j)
 114 do a2 = 1, 10
 115   do j = 1, a2*2-1
 116     arr(j, a2) = j + 100 * a2
 117   end do
 118 end do
 119 if (any (ref /= arr)) error stop
 120 if (j /= lp_j) error stop
 121
 122 ! { dg-final { scan-tree-dump-times "for \\(a3\\.\[0-9\]+ = 1; a3\\.\[0-9\]+ <= 10; a3\\.\[0-9\]+ = a3\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
 123 ! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a3\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
 124 ! { dg-final { scan-tree-dump-times "\\*\\*a3 = a3\\.\[0-9\]+;" 1 "original" } }
 125 arr = 44
 126 a3 = 99; j = 99
 127 !$omp simd collapse(2) lastprivate(a3,j)
 128 do a3 = 1, 10
 129   do j = 1, a3*2-1
 130     arr(j, a3) = j + 100 * a3
 131   end do
 132 end do
 133 if (any (ref /= arr)) error stop
 134 if (a3 /= lp_i .or. j /= lp_j) error stop
 135
 136 ! { dg-final { scan-tree-dump-times "for \\(a4\\.\[0-9\]+ = 1; a4\\.\[0-9\]+ <= 10; a4\\.\[0-9\]+ = a4\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
 137 ! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a4\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
 138 ! { dg-final { scan-tree-dump-times "\\*\\*a4 = a4\\.\[0-9\]+;" 1 "original" } }
 139 arr = 44
 140 a4 = 99; j = 99
 141 !$omp simd collapse(2) lastprivate(a4,j)
 142 do a4 = 1, 10
 143   do j = 1, a4*2-1
 144     arr(j, a4) = j + 100 * a4
 145   end do
 146 end do
 147 if (any (ref /= arr)) error stop
 148 if (a4 /= lp_i .or. j /= lp_j) error stop
 149
 150 ! { dg-final { scan-tree-dump-times "for \\(a5 = 1; a5 <= 10; a5 = a5 \\+ 1\\)" 1 "original" } }
 151 ! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a5 \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
 152 ! -> no temp var
 153 arr = 44
 154 a5 = 99; j = 99
 155 !$omp simd collapse(2) lastprivate(a5,j)
 156 do a5 = 1, 10
 157   do j = 1, a5*2-1
 158     arr(j, a5) = j + 100 * a5
 159   end do
 160 end do
 161 if (any (ref /= arr)) error stop
 162 if (a5 /= lp_i .or. j /= lp_j) error stop
 163
 164 ! { dg-final { scan-tree-dump-times "for \\(a6\\.\[0-9\]+ = 1; a6\\.\[0-9\]+ <= 10; a6\\.\[0-9\]+ = a6\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
 165 ! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a6\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
 166 ! { dg-final { scan-tree-dump-times "\\*a6 = a6\\.\[0-9\]+;" 1 "original" } }
 167 arr = 44
 168 a6 = 99; j = 99
 169 ! no last private for 'a6' as "The initial status of a private pointer is undefined."
 170 !$omp simd collapse(2) lastprivate(j)
 171 do a6 = 1, 10
 172   do j = 1, a6*2-1
 173     arr(j, a6) = j + 100 * a6
 174   end do
 175 end do
 176 if (any (ref /= arr)) error stop
 177 if (j /= lp_j) error stop
 178
 179 ! { dg-final { scan-tree-dump-times "for \\(a7\\.\[0-9\]+ = 1; a7\\.\[0-9\]+ <= 10; a7\\.\[0-9\]+ = a7\\.\[0-9\]+ \\+ 1\\)" 1 "original" } }
 180 ! { dg-final { scan-tree-dump-times "for \\(j = 1; j <= a7\\.\[0-9\]+ \\* 2 \\+ -1; j = j \\+ 1\\)" 1 "original" } }
 181 ! { dg-final { scan-tree-dump-times "\\*a7 = a7\\.\[0-9\]+;" 1 "original" } }
 182 arr = 44
 183 a7 = 99; j = 99
 184 !$omp simd collapse(2) lastprivate(a7,j)
 185 do a7 = 1, 10
 186   do j = 1, a7*2-1
 187     arr(j, a7) = j + 100 * a7
 188   end do
 189 end do
 190 if (any (ref /= arr)) error stop
 191 if (a7 /= lp_i .or. j /= lp_j) error stop
 192
 193 deallocate(a6, a7)
 194 end
 195
 196 end module m
 197
 198
 199 use m
 200 implicit none
 201
 202 integer :: av
 203 integer :: avo
 204 integer :: a0
 205 integer :: a0o
 206 integer, pointer :: a1
 207 integer, pointer :: a2
 208 integer, allocatable :: a3
 209 integer, allocatable :: a4
 210
 211 av = -99; avo = -99
 212 allocate(a1,a2,a3,a4)
 213 call foo (av, avo, a0, a0o, a1, a2, a3, a4)
 214 deallocate(a1,a2,a3,a4)
 215 end