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

   1 ! Program to test MOD and MODULO intrinsics
   2 subroutine integertest (ops, res)
   3    implicit none
   4    integer, dimension(2) :: ops
   5    integer, dimension(2) :: res
   6
   7    if ((mod(ops(1), ops(2)) .ne. res(1)) .or. &
   8        (modulo(ops(1), ops(2)) .ne. res(2))) call abort
   9 end subroutine
  10
  11 subroutine real4test (ops, res)
  12    implicit none
  13    real(kind=4), dimension(2) :: ops
  14    real(kind=4), dimension(2) :: res
  15
  16    if (diff(mod(ops(1), ops(2)), res(1)) .or. &
  17        diff(modulo(ops(1), ops(2)), res(2))) call abort
  18 contains
  19 function diff(a, b)
  20   real(kind=4) :: a, b
  21   logical diff
  22
  23   diff = (abs (a - b) .gt. abs(a * 1e-6))
  24 end function
  25 end subroutine
  26
  27 subroutine real8test (ops, res)
  28    implicit none
  29    real(kind=8), dimension(2) :: ops
  30    real(kind=8), dimension(2) :: res
  31
  32    if (diff(mod(ops(1), ops(2)), res(1)) .or. &
  33        diff(modulo(ops(1), ops(2)), res(2))) call abort
  34 contains
  35 function diff(a, b)
  36   real(kind=8) :: a, b
  37   logical diff
  38
  39   diff = (abs(a - b) .gt. abs(a * 1e-6))
  40 end function
  41 end subroutine
  42
  43 program mod_modulotest
  44    implicit none
  45
  46    call integertest ((/8, 5/), (/3, 3/))
  47    call integertest ((/-8, 5/), (/-3, 2/))
  48    call integertest ((/8, -5/), (/3, -2/))
  49    call integertest ((/-8, -5/), (/-3, -3/))
  50    call integertest ((/ 2, -1/), (/0, 0/))
  51
  52    call real4test ((/3.0, 2.5/), (/0.5, 0.5/))
  53    call real4test ((/-3.0, 2.5/), (/-0.5, 2.0/))
  54    call real4test ((/3.0, -2.5/), (/0.5, -2.0/))
  55    call real4test ((/-3.0, -2.5/), (/-0.5, -0.5/))
  56    call real4test ((/ 2.0, -1.0/), (/ 0.0, 0.0 /))
  57
  58    call real8test ((/3.0_8, 2.5_8/), (/0.5_8, 0.5_8/))
  59    call real8test ((/-3.0_8, 2.5_8/), (/-0.5_8, 2.0_8/))
  60    call real8test ((/3.0_8, -2.5_8/), (/0.5_8, -2.0_8/))
  61    call real8test ((/-3.0_8, -2.5_8/), (/-0.5_8, -0.5_8/))
  62    call real8test ((/ 2.0_8, -1.0_8/), (/ 0.0_8, 0.0_8 /))
  63
  64    ! Check large numbers
  65    call real4test ((/2e34, 1.0/), (/0.0, 0.0/))
  66    call real4test ((/2e34, 1.5e34/), (/0.5e34, 0.5e34/))
  67 end program