1C Test profile-directed block ordering with various Fortran 77 constructs 2C to catch basic regressions in the functionality. 3 4 program bprob1 5 implicit none 6 integer i,j,k,n 7 integer result 8 integer lpall, ieall, gtall 9 integer lpval, ieval, gtval 10 11 lpval = lpall() 12 ieval = ieall() 13 gtval = gtall() 14 if ((lpval .ne. 1) .or. (ieval .ne. 1) .or. (gtval .ne. 1)) then 15 call abort 16 end if 17 18 end 19 20C Pass a value through a function to thwart optimization. 21 integer function foo(i) 22 implicit none 23 integer i 24 foo = i 25 end 26 27C Test various flavors of GOTO and compare results against expected values. 28 integer function gtall() 29 implicit none 30 integer gt1, gt2, gt3, gt4, gt5 31 integer gtval 32 33 gtall = 1 34 gtval = 0 35 gtval = gtval + gt1(0) 36 gtval = gtval + gt1(1) 37 if (gtval .ne. 3) then 38 print *,"gtall part 1: ", gtval, 3 39 gtall = 0 40 end if 41 42 gtval = 0 43 gtval = gtval + gt2(3) 44 gtval = gtval + gt2(30) 45 if (gtval .ne. 12) then 46 print *,"gtall part 2: ", gtval, 12 47 gtall = 0 48 end if 49 50 gtval = 0 51 gtval = gtval + gt3(0) 52 gtval = gtval + gt3(3) 53 if (gtval .ne. 48) then 54 print *,"gtall part 3: ", gtval, 48 55 gtall = 0 56 end if 57 58 gtval = 0 59 gtval = gtval + gt4(1) 60 gtval = gtval + gt4(2) 61 gtval = gtval + gt4(3) 62 if (gtval .ne. 14) then 63 print *,"gtall part 4: ", gtval, 14 64 gtall = 0 65 end if 66 67 gtval = 0 68 gtval = gtval + gt5(0) 69 gtval = gtval + gt5(-1) 70 gtval = gtval + gt5(5) 71 if (gtval .ne. 14) then 72 print *,"gtall part 5: ", gtval, 14 73 gtall = 0 74 end if 75 end 76 77C Test simple GOTO. 78 integer function gt1(f) 79 implicit none 80 integer f 81 if (f .ne. 0) goto 100 82 gt1 = 1 83 goto 101 84 100 gt1 = 2 85 101 continue 86 end 87 88C Test simple GOTO again, this time out of a DO loop. 89 integer function gt2(f) 90 implicit none 91 integer f 92 integer i 93 do i=1,10 94 if (i .eq. f) goto 100 95 end do 96 gt2 = 4 97 goto 101 98 100 gt2 = 8 99 101 continue 100 end 101 102C Test computed GOTO. 103 integer function gt3(i) 104 implicit none 105 integer i 106 gt3 = 8 107 goto (101, 102, 103, 104), i 108 goto 105 109 101 gt3 = 1024 110 goto 105 111 102 gt3 = 2048 112 goto 105 113 103 gt3 = 16 114 goto 105 115 104 gt3 = 4096 116 goto 105 117 105 gt3 = gt3 * 2 118 end 119 120C Test assigned GOTO. 121 integer function gt4(i) 122 implicit none 123 integer i 124 integer label 125 assign 101 to label 126 if (i .eq. 2) assign 102 to label 127 if (i .eq. 3) assign 103 to label 128 goto label, (101, 102, 103) 129 101 gt4 = 1 130 goto 104 131 102 gt4 = 2 132 goto 104 133 103 gt4 = 4 134 104 gt4 = gt4 * 2 135 end 136 137C Test arithmetic IF (bundled with the GOTO variants). 138 integer function gt5(i) 139 implicit none 140 integer i 141 gt5 = 1 142 if (i) 101, 102, 103 143 101 gt5 = 2 144 goto 104 145 102 gt5 = 4 146 goto 104 147 103 gt5 = 8 148 104 continue 149 end 150 151C Run all of the loop tests and check results against expected values. 152 integer function lpall() 153 implicit none 154 integer loop1, loop2 155 integer loopval 156 157 lpall = 1 158 loopval = 0 159 loopval = loopval + loop1(1,0) 160 loopval = loopval + loop1(1,2) 161 loopval = loopval + loop1(1,7) 162 if (loopval .ne. 12) then 163 print *,"lpall part 1: ", loopval, 12 164 lpall = 0 165 end if 166 167 loopval = 0 168 loopval = loopval + loop2(1,0,0,0) 169 loopval = loopval + loop2(1,1,0,0) 170 loopval = loopval + loop2(1,1,3,0) 171 loopval = loopval + loop2(1,1,3,1) 172 loopval = loopval + loop2(1,3,1,5) 173 loopval = loopval + loop2(1,3,7,3) 174 if (loopval .ne. 87) then 175 print *,"lpall part 2: ", loopval, 87 176 lpall = 0 177 end if 178 end 179 180C Test a simple DO loop. 181 integer function loop1(r,n) 182 implicit none 183 integer r,n,i 184 185 loop1 = r 186 do i=1,n 187 loop1 = loop1 + 1 188 end do 189 end 190 191C Test nested DO loops. 192 integer function loop2(r, l, m, n) 193 implicit none 194 integer r,l,m,n 195 integer i,j,k 196 loop2 = r 197 do i=1,l 198 do j=1,m 199 do k=1,n 200 loop2 = loop2 + 1 201 end do 202 end do 203 end do 204 end 205 206C Test various combinations of IF-THEN-ELSE and check results against 207C expected values. 208 integer function ieall() 209 implicit none 210 integer ie1, ie2, ie3 211 integer ieval 212 ieall = 1 213 ieval = 0 214 215 ieval = ieval + ie1(0,2) 216 ieval = ieval + ie1(0,0) 217 ieval = ieval + ie1(1,2) 218 ieval = ieval + ie1(10,2) 219 ieval = ieval + ie1(11,11) 220 if (ieval .ne. 31) then 221 print *,"ieall part 1: ", ieval, 31 222 ieall = 0 223 end if 224 225 ieval = 0 226 ieval = ieval + ie2(0) 227 ieval = ieval + ie2(2) 228 ieval = ieval + ie2(2) 229 ieval = ieval + ie2(2) 230 ieval = ieval + ie2(3) 231 ieval = ieval + ie2(3) 232 if (ieval .ne. 23) then 233 print *,"ieall part 2: ", ieval, 23 234 ieall = 0 235 end if 236 237 ieval = 0 238 ieval = ieval + ie3(11,19) 239 ieval = ieval + ie3(25,27) 240 ieval = ieval + ie3(11,22) 241 ieval = ieval + ie3(11,10) 242 ieval = ieval + ie3(21,32) 243 ieval = ieval + ie3(21,20) 244 ieval = ieval + ie3(1,2) 245 ieval = ieval + ie3(32,31) 246 ieval = ieval + ie3(3,0) 247 ieval = ieval + ie3(0,47) 248 ieval = ieval + ie3(65,65) 249 if (ieval .ne. 246) then 250 print *,"ieall part 3: ", ieval, 246 251 ieall = 0 252 end if 253 end 254 255C Test IF-THEN-ELSE. 256 integer function ie1(i,j) 257 implicit none 258 integer i,j 259 integer foo 260 261 ie1 = 0 262 if (i .ne. 0) then 263 if (j .ne. 0) then 264 ie1 = foo(4) 265 else 266 ie1 = foo(1024) 267 end if 268 else 269 if (j .ne. 0) then 270 ie1 = foo(1) 271 else 272 ie1 = foo(2) 273 end if 274 end if 275 if (i .gt. j) then 276 ie1 = foo(ie1*2) 277 end if 278 if (i .gt. 10) then 279 if (j .gt. 10) then 280 ie1 = foo(ie1*4) 281 end if 282 end if 283 end 284 285C Test a series of simple IF-THEN statements. 286 integer function ie2(i) 287 implicit none 288 integer i 289 integer foo 290 ie2 = 0 291 292 if (i .eq. 0) then 293 ie2 = foo(1) 294 end if 295 if (i .eq. 1) then 296 ie2 = foo(1024) 297 end if 298 if (i .eq. 2) then 299 ie2 = foo(2) 300 end if 301 if (i .eq. 3) then 302 ie2 = foo(8) 303 end if 304 if (i .eq. 4) then 305 ie2 = foo(2048) 306 end if 307 308 end 309 310C Test nested IF statements and IF with compound expressions. 311 integer function ie3(i,j) 312 implicit none 313 integer i,j 314 integer foo 315 316 ie3 = 1 317 if ((i .gt. 10) .and. (j .gt. i) .and. (j .lt. 20)) then 318 ie3 = foo(16) 319 end if 320 if (i .gt. 20) then 321 if (j .gt. i) then 322 if (j .lt. 30) then 323 ie3 = foo(32) 324 end if 325 end if 326 end if 327 if ((i .eq. 3) .or. (j .eq. 47) .or. (i .eq.j)) then 328 ie3 = foo(64) 329 end if 330 end 331