gcc/testsuite/g77.f-torture/execute/19990419-1.f

   1 * Test DO WHILE, to make sure it fully reevaluates its expression.
   2 * Belongs in execute/.
   3       common /x/ ival
   4       j = 0
   5       do while (i() .eq. 1)
   6          j = j + 1
   7          if (j .gt. 5) call abort
   8       end do
   9       if (j .ne. 4) call abort
  10       if (ival .ne. 5) call abort
  11       end
  12       function i()
  13       common /x/ ival
  14       ival = ival + 1
  15       i = 10
  16       if (ival .lt. 5) i = 1
  17       end
  18       block data
  19       common /x/ ival
  20       data ival/0/
  21       end