gcc/testsuite/gfortran.dg/ieee/underflow_1.f90

   1 ! { dg-do run }
   2 ! { dg-require-effective-target sse2_runtime { target { i?86-*-* x86_64-*-* } } }
   3 ! { dg-additional-options "-msse2 -mfpmath=sse" { target { i?86-*-* x86_64-*-* } } }
   4
   5 program test_underflow_control
   6   use ieee_arithmetic
   7   use iso_fortran_env
   8
   9   logical l
  10   real, volatile :: x
  11   double precision, volatile :: y
  12   integer, parameter :: kx = kind(x), ky = kind(y)
  13
  14   if (ieee_support_underflow_control(x)) then
  15
  16     x = tiny(x)
  17     call ieee_set_underflow_mode(.true.)
  18     x = x / 2000._kx
  19     if (x == 0) STOP 1
  20     call ieee_get_underflow_mode(l)
  21     if (.not. l) STOP 2
  22
  23     x = tiny(x)
  24     call ieee_set_underflow_mode(.false.)
  25     x = x / 2000._kx
  26     if (x > 0) STOP 3
  27     call ieee_get_underflow_mode(l)
  28     if (l) STOP 4
  29
  30   end if
  31
  32   if (ieee_support_underflow_control(y)) then
  33
  34     y = tiny(y)
  35     call ieee_set_underflow_mode(.true.)
  36     y = y / 2000._ky
  37     if (y == 0) STOP 5
  38     call ieee_get_underflow_mode(l)
  39     if (.not. l) STOP 6
  40
  41     y = tiny(y)
  42     call ieee_set_underflow_mode(.false.)
  43     y = y / 2000._ky
  44     if (y > 0) STOP 7
  45     call ieee_get_underflow_mode(l)
  46     if (l) STOP 8
  47
  48   end if
  49
  50 end program