gcc/testsuite/gfortran.dg/gamma_5.f90

   1 ! { dg-do run }
   2 ! { dg-xfail-if "" { "*-*-freebsd*" } { "*" }  { "" } }
   3 ! PR 33683 - we used to pick up the wrong gamma function
   4 ! from the library on some systems.
   5 program main
   6   implicit none
   7   integer, parameter :: n_max = 20
   8   double precision, dimension(0:n_max) :: c
   9   double precision :: pi
  10   integer :: n
  11   double precision :: td, xd
  12   real :: ts,xs
  13
  14   pi = 4 * atan(1.d0)
  15   c(0) = 1.
  16   do n=1, n_max
  17      c(n) = (2*n-1)*c(n-1)*0.5d0
  18   end do
  19
  20   do n=1, n_max
  21      xs = n + 0.5
  22      xd = n + 0.5d0
  23      td = c(n)*sqrt(pi)
  24      ts = c(n)*sqrt(pi)
  25      if (abs(gamma(xs)-ts)/ts > 3e-6) call abort
  26      if (abs(gamma(xd)-td)/td > 5e-14) call abort
  27   end do
  28   call tst_s(2.3, gamma(2.3))
  29   call tst_s(3.7, gamma(3.7))
  30   call tst_s(5.5, gamma(5.5))
  31   call tst_d(4.2d0, gamma(4.2d0))
  32   call tst_d(8.1d0, gamma(8.1d0))
  33 contains
  34   subroutine tst_s(a, b)
  35     real :: a, b
  36     if (abs(gamma(a) - b)/b > 1e-6) call abort
  37   end subroutine tst_s
  38
  39   subroutine tst_d(a, b)
  40     double precision :: a,b
  41     if (abs(gamma(a) - b)/b > 5e-14) call abort
  42   end subroutine tst_d
  43 end program main