gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_aint_anint.f90

   1 ! Program to test AINT and ANINT intrinsics
   2
   3 subroutine real4test (op, res1, res2)
   4    implicit none
   5    real(kind=4) :: op
   6    real(kind=4) :: res1, res2
   7
   8    if (diff(aint(op), res1) .or. &
   9        diff(anint(op), res2)) call abort
  10 contains
  11 function diff(a, b)
  12   real(kind=4) :: a, b
  13   logical diff
  14
  15   diff = (abs (a - b) .gt. abs(a * 1e-6))
  16 end function
  17 end subroutine
  18
  19 subroutine real8test (op, res1, res2)
  20    implicit none
  21    real(kind=8) :: op
  22    real(kind=8) :: res1, res2
  23
  24    if (diff(aint(op), res1) .or. &
  25        diff(anint(op), res2)) call abort
  26 contains
  27 function diff(a, b)
  28   real(kind=8) :: a, b
  29   logical diff
  30
  31   diff = (abs(a - b) .gt. abs(a * 1e-6))
  32 end function
  33 end subroutine
  34
  35 program aint_aninttest
  36    implicit none
  37
  38    call real4test (3.456, 3.0, 3.0)
  39    call real4test (-2.798, -2.0, -3.0)
  40    call real4test (3.678, 3.0, 4.0)
  41    call real4test (-1.375, -1.0, -1.0)
  42    call real4test (-0.5, 0.0,-1.0)
  43    call real4test (0.4, 0.0,0.0)
  44
  45    call real8test (3.456_8, 3.0_8, 3.0_8)
  46    call real8test (-2.798_8, -2.0_8, -3.0_8)
  47    call real8test (3.678_8, 3.0_8, 4.0_8)
  48    call real8test (-1.375_8, -1.0_8, -1.0_8)
  49    call real8test (-0.5_8, 0.0_8,-1.0_8)
  50    call real8test (0.4_8, 0.0_8,0.0_8)
  51
  52    ! Check large numbers
  53    call real4test (2e34, 2e34, 2e34)
  54    call real4test (-2e34, -2e34, -2e34)
  55 end program