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