gcc/testsuite/g77.dg/bprob/g77-bprob-1.f

   1 C Test profile-directed block ordering with various Fortran 77 constructs
   2 C 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
  20 C 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
  27 C 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
  77 C 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
  88 C 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
 102 C 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
 120 C 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
 137 C 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
 151 C 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
 180 C 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
 191 C 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
 206 C Test various combinations of IF-THEN-ELSE and check results against
 207 C 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
 255 C 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
 285 C 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
 310 C 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