(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
ieee/
intrinsics_1.f90
! { dg-do run }
! { dg-additional-options "-fno-range-check" }
!
! Check compile-time simplification of functions FRACTION, EXPONENT,
! SPACING, RRSPACING and SET_EXPONENT for special values.

program test
  implicit none
  real, parameter :: inf = 2 * huge(0.)
  real, parameter :: nan = 0. / 0.

  call check_positive_zero(fraction(0.))
  call check_negative_zero(fraction(-0.))
  if (.not. isnan(fraction(inf))) STOP 1
  if (.not. isnan(fraction(-inf))) STOP 2
  if (.not. isnan(fraction(nan))) STOP 3

  if (exponent(0.) /= 0) STOP 4
  if (exponent(-0.) /= 0) STOP 5
  if (exponent(inf) /= huge(0)) STOP 6
  if (exponent(-inf) /= huge(0)) STOP 7
  if (exponent(nan) /= huge(0)) STOP 8

  if (spacing(0.) /= spacing(tiny(0.))) STOP 9
  if (spacing(-0.) /= spacing(tiny(0.))) STOP 10
  if (.not. isnan(spacing(inf))) STOP 11
  if (.not. isnan(spacing(-inf))) STOP 12
  if (.not. isnan(spacing(nan))) STOP 13

  call check_positive_zero(rrspacing(0.))
  call check_positive_zero(rrspacing(-0.))
  if (.not. isnan(rrspacing(inf))) STOP 14
  if (.not. isnan(rrspacing(-inf))) STOP 15
  if (.not. isnan(rrspacing(nan))) STOP 16

  call check_positive_zero(set_exponent(0.,42))
  call check_negative_zero(set_exponent(-0.,42))
  if (.not. isnan(set_exponent(inf, 42))) STOP 17
  if (.not. isnan(set_exponent(-inf, 42))) STOP 18
  if (.not. isnan(set_exponent(nan, 42))) STOP 19

contains

  subroutine check_positive_zero(x)
    use ieee_arithmetic
    implicit none
    real, value :: x

    if (ieee_class (x) /= ieee_positive_zero) STOP 20
  end

  subroutine check_negative_zero(x)
    use ieee_arithmetic
    implicit none
    real, value :: x

    if (ieee_class (x) /= ieee_negative_zero) STOP 21
  end

end