g77-bprob-1.f   [plain text]

C Test profile-directed block ordering with various Fortran 77 constructs
C to catch basic regressions in the functionality.

      program bprob1
      implicit none
      integer i,j,k,n
      integer result
      integer lpall, ieall, gtall
      integer lpval, ieval, gtval

      lpval = lpall()
      ieval = ieall()
      gtval = gtall()
      if ((lpval .ne. 1) .or. (ieval .ne. 1) .or. (gtval .ne. 1)) then
         call abort
      end if
      
      end

C Pass a value through a function to thwart optimization.
      integer function foo(i)
      implicit none
      integer i
      foo = i
      end

C Test various flavors of GOTO and compare results against expected values.
      integer function gtall()
      implicit none
      integer gt1, gt2, gt3, gt4, gt5
      integer gtval

      gtall = 1
      gtval = 0
      gtval = gtval + gt1(0)
      gtval = gtval + gt1(1)
      if (gtval .ne. 3) then
         print *,"gtall part 1:  ", gtval, 3
         gtall = 0
      end if

      gtval = 0
      gtval = gtval + gt2(3)
      gtval = gtval + gt2(30)
      if (gtval .ne. 12) then
         print *,"gtall part 2:  ", gtval, 12
         gtall = 0
      end if

      gtval = 0
      gtval = gtval + gt3(0)
      gtval = gtval + gt3(3)
      if (gtval .ne. 48) then
         print *,"gtall part 3:  ", gtval, 48
         gtall = 0
      end if

      gtval = 0
      gtval = gtval + gt4(1)
      gtval = gtval + gt4(2)
      gtval = gtval + gt4(3)
      if (gtval .ne. 14) then
         print *,"gtall part 4:  ", gtval, 14
         gtall = 0
      end if

      gtval = 0
      gtval = gtval + gt5(0)
      gtval = gtval + gt5(-1)
      gtval = gtval + gt5(5)
      if (gtval .ne. 14) then
         print *,"gtall part 5:  ", gtval, 14
         gtall = 0
      end if
      end

C Test simple GOTO.
      integer function gt1(f)
      implicit none
      integer f
      if (f .ne. 0) goto 100
      gt1 = 1
      goto 101
  100 gt1 = 2
  101 continue
      end

C Test simple GOTO again, this time out of a DO loop.
      integer function gt2(f)
      implicit none
      integer f
      integer i
      do i=1,10
         if (i .eq. f) goto 100
      end do
      gt2 = 4
      goto 101
  100 gt2 = 8
  101 continue
      end

C Test computed GOTO.
      integer function gt3(i)
      implicit none
      integer i
      gt3 = 8
      goto (101, 102, 103, 104), i
      goto 105
  101 gt3 = 1024
      goto 105
  102 gt3 = 2048
      goto 105
  103 gt3 = 16
      goto 105
  104 gt3 = 4096
      goto 105
  105 gt3 = gt3 * 2
      end

C Test assigned GOTO.
      integer function gt4(i)
      implicit none
      integer i
      integer label
      assign 101 to label
      if (i .eq. 2) assign 102 to label
      if (i .eq. 3) assign 103 to label
      goto label, (101, 102, 103)
  101 gt4 = 1
      goto 104
  102 gt4 = 2
      goto 104
  103 gt4 = 4
  104 gt4 = gt4 * 2
      end

C Test arithmetic IF (bundled with the GOTO variants).
      integer function gt5(i)
      implicit none
      integer i
      gt5 = 1
      if (i) 101, 102, 103
  101 gt5 = 2
      goto 104
  102 gt5 = 4
      goto 104
  103 gt5 = 8
  104 continue
      end

C Run all of the loop tests and check results against expected values.
      integer function lpall()
      implicit none
      integer loop1, loop2
      integer loopval

      lpall = 1
      loopval = 0
      loopval = loopval + loop1(1,0)
      loopval = loopval + loop1(1,2)
      loopval = loopval + loop1(1,7)
      if (loopval .ne. 12) then
         print *,"lpall part 1:  ", loopval, 12
         lpall = 0
      end if

      loopval = 0
      loopval = loopval + loop2(1,0,0,0)
      loopval = loopval + loop2(1,1,0,0)
      loopval = loopval + loop2(1,1,3,0)
      loopval = loopval + loop2(1,1,3,1)
      loopval = loopval + loop2(1,3,1,5)
      loopval = loopval + loop2(1,3,7,3)
      if (loopval .ne. 87) then
         print *,"lpall part 2:  ", loopval, 87
         lpall = 0
      end if
      end

C Test a simple DO loop.
      integer function loop1(r,n)
      implicit none
      integer r,n,i

      loop1 = r
      do i=1,n
         loop1 = loop1 + 1
      end do
      end

C Test nested DO loops.
      integer function loop2(r, l, m, n)
      implicit none
      integer r,l,m,n
      integer i,j,k
      loop2 = r
      do i=1,l
         do j=1,m
            do k=1,n
               loop2 = loop2 + 1
            end do
         end do
      end do
      end

C Test various combinations of IF-THEN-ELSE and check results against
C expected values.
      integer function ieall()
      implicit none
      integer ie1, ie2, ie3
      integer ieval
      ieall = 1
      ieval = 0
      
      ieval = ieval + ie1(0,2)
      ieval = ieval + ie1(0,0)
      ieval = ieval + ie1(1,2)
      ieval = ieval + ie1(10,2)
      ieval = ieval + ie1(11,11)
      if (ieval .ne. 31) then
         print *,"ieall part 1:  ", ieval, 31
         ieall = 0
      end if

      ieval = 0
      ieval = ieval + ie2(0)
      ieval = ieval + ie2(2)
      ieval = ieval + ie2(2)
      ieval = ieval + ie2(2)
      ieval = ieval + ie2(3)
      ieval = ieval + ie2(3)
      if (ieval .ne. 23) then
         print *,"ieall part 2:  ", ieval, 23
         ieall = 0
      end if

      ieval = 0
      ieval = ieval + ie3(11,19)
      ieval = ieval + ie3(25,27)
      ieval = ieval + ie3(11,22)
      ieval = ieval + ie3(11,10)
      ieval = ieval + ie3(21,32)
      ieval = ieval + ie3(21,20)
      ieval = ieval + ie3(1,2)
      ieval = ieval + ie3(32,31)
      ieval = ieval + ie3(3,0)
      ieval = ieval + ie3(0,47)
      ieval = ieval + ie3(65,65)
      if (ieval .ne. 246) then
         print *,"ieall part 3:  ", ieval, 246
         ieall = 0
      end if
      end

C Test IF-THEN-ELSE.
      integer function ie1(i,j)
      implicit none
      integer i,j
      integer foo

      ie1 = 0
      if (i .ne. 0) then
         if (j .ne. 0) then
            ie1 = foo(4)
         else
            ie1 = foo(1024)
         end if
      else
         if (j .ne. 0) then
            ie1 = foo(1)
         else
            ie1 = foo(2)
         end if
      end if
      if (i .gt. j) then
         ie1 = foo(ie1*2)
      end if
      if (i .gt. 10) then
         if (j .gt. 10) then
            ie1 = foo(ie1*4)
         end if
      end if
      end

C Test a series of simple IF-THEN statements.
      integer function ie2(i)
      implicit none
      integer i
      integer foo
      ie2 = 0

      if (i .eq. 0) then
         ie2 = foo(1)
      end if
      if (i .eq. 1) then
         ie2 = foo(1024)
      end if
      if (i .eq. 2) then
         ie2 = foo(2)
      end if
      if (i .eq. 3) then
         ie2 = foo(8)
      end if
      if (i .eq. 4) then
         ie2 = foo(2048)
      end if

      end

C Test nested IF statements and IF with compound expressions.
      integer function ie3(i,j)
      implicit none
      integer i,j
      integer foo

      ie3 = 1
      if ((i .gt. 10) .and. (j .gt. i) .and. (j .lt. 20)) then
         ie3 = foo(16)
      end if
      if (i .gt. 20) then
         if (j .gt. i) then
            if (j .lt. 30) then
               ie3 = foo(32)
            end if
         end if
      end if
      if ((i .eq. 3) .or. (j .eq. 47) .or. (i .eq.j)) then
         ie3 = foo(64)
      end if
      end