gomp-20050608-branch/gcc/testsuite/gfortran.dg/g77/20010216-1.f

   1 C Test for bug in reg-stack handling conditional moves.
   2 C Reported by Tim Prince <tprince@computer.org>
   3 C
   4 C { dg-do run { target { { i[6789]86-*-* x86_64-*-* } && ilp32 } } }
   5 C { dg-options "-ffast-math -march=pentiumpro" }
   6
   7       double precision function foo(x, y)
   8          implicit none
   9          double precision x, y
  10          double precision a, b, c, d
  11          if (x /= y) then
  12              if (x * y >= 0) then
  13                  a = abs(x)
  14                  b = abs(y)
  15                  c = max(a, b)
  16                  d = min(a, b)
  17                  foo = 1 - d/c
  18              else
  19                  foo = 1
  20              end if
  21          else
  22              foo = 0
  23          end if
  24       end
  25
  26       program test
  27       implicit none
  28
  29       integer ntests
  30       parameter (ntests=7)
  31       double precision tolerance
  32       parameter (tolerance=1.0D-6)
  33
  34 C Each column is a pair of values to feed to foo,
  35 C and its expected return value.
  36       double precision a(ntests), b(ntests), x(ntests)
  37       data a /1, -23, -1,   1,   9,  10,  -9/
  38       data b /1, -23, 12, -12,  10,   9, -10/
  39       data x /0,   0,  1,   1, 0.1, 0.1, 0.1/
  40
  41       double precision foo
  42       double precision result
  43       integer i
  44
  45       do i = 1, ntests
  46          result = foo(a(i), b(i))
  47          if (abs(result - x(i)) > tolerance) then
  48            print *, i, a(i), b(i), x(i), result
  49            call abort
  50          end if
  51       end do
  52       end