view gcc/testsuite/gfortran.dg/ieee/intrinsics_2.F90 @ 152:2b5abeee2509

update gcc11
author anatofuz
date Mon, 25 May 2020 07:50:57 +0900
parents 84e7813d76e9
children
line wrap: on
line source

! { dg-do run }
! { dg-additional-options "-fno-range-check" }
!
! Check handling of special values by FRACTION, EXPONENT,
! SPACING, RRSPACING and SET_EXPONENT.

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

  real, volatile :: x

  x = 0.
  call check_positive_zero(fraction(x))
  if (exponent(x) /= 0) STOP 1
  if (spacing(x) /= spacing(tiny(x))) STOP 2
  call check_positive_zero(rrspacing(x))
  call check_positive_zero(set_exponent(x,42))

  x = -0.
  call check_negative_zero(fraction(x))
  if (exponent(x) /= 0) STOP 3
  if (spacing(x) /= spacing(tiny(x))) STOP 4
  call check_positive_zero(rrspacing(x))
  call check_negative_zero(set_exponent(x,42))

  x = inf
  if (.not. isnan(fraction(x))) STOP 5
  if (exponent(x) /= huge(0)) STOP 6
  if (.not. isnan(spacing(x))) STOP 7
  if (.not. isnan(rrspacing(x))) STOP 8
  if (.not. isnan(set_exponent(x, 42))) STOP 9

  x = -inf
  if (.not. isnan(fraction(x))) STOP 10
  if (exponent(x) /= huge(0)) STOP 11
  if (.not. isnan(spacing(x))) STOP 12
  if (.not. isnan(rrspacing(x))) STOP 13
  if (.not. isnan(set_exponent(x, 42))) STOP 14

  x = nan
  if (.not. isnan(fraction(x))) STOP 15
  if (exponent(x) /= huge(0)) STOP 16
  if (.not. isnan(spacing(x))) STOP 17
  if (.not. isnan(rrspacing(x))) STOP 18
  if (.not. isnan(set_exponent(x, 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