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

   1 ! { dg-do run }
   2 ! { dg-require-effective-target issignaling } */
   3 ! { dg-additional-sources signaling_2_c.c }
   4 ! { dg-additional-options "-w" }
   5 ! the -w option is needed to make cc1 not report a warning for
   6 ! the -fintrinsic-modules-path option passed by ieee.exp
   7 !
   8 program test
   9   use, intrinsic :: iso_c_binding
  10   use, intrinsic :: ieee_arithmetic
  11   implicit none
  12
  13   interface
  14     integer(kind=c_int) function isnansf (x) bind(c)
  15       import :: c_float, c_int
  16       real(kind=c_float), value :: x
  17     end function
  18
  19     integer(kind=c_int) function isnans (x) bind(c)
  20       import :: c_double, c_int
  21       real(kind=c_double), value :: x
  22     end function
  23
  24     integer(kind=c_int) function isnansl (x) bind(c)
  25       import :: c_long_double, c_int
  26       real(kind=c_long_double), value :: x
  27     end function
  28   end interface
  29
  30   real(kind=c_float) :: x
  31   real(kind=c_double) :: y
  32   real(kind=c_long_double) :: z
  33
  34   if (ieee_support_nan(x)) then
  35     x = ieee_value(x, ieee_signaling_nan)
  36     if (ieee_class(x) /= ieee_signaling_nan) stop 100
  37     if (.not. ieee_is_nan(x)) stop 101
  38     if (isnansf(x) /= 1) stop 102
  39
  40     x = ieee_value(x, ieee_quiet_nan)
  41     if (ieee_class(x) /= ieee_quiet_nan) stop 103
  42     if (.not. ieee_is_nan(x)) stop 104
  43     if (isnansf(x) /= 0) stop 105
  44   end if
  45
  46   if (ieee_support_nan(y)) then
  47     y = ieee_value(y, ieee_signaling_nan)
  48     if (ieee_class(y) /= ieee_signaling_nan) stop 100
  49     if (.not. ieee_is_nan(y)) stop 101
  50     if (isnans(y) /= 1) stop 102
  51
  52     y = ieee_value(y, ieee_quiet_nan)
  53     if (ieee_class(y) /= ieee_quiet_nan) stop 103
  54     if (.not. ieee_is_nan(y)) stop 104
  55     if (isnans(y) /= 0) stop 105
  56   end if
  57
  58   if (ieee_support_nan(z)) then
  59     z = ieee_value(z, ieee_signaling_nan)
  60     if (ieee_class(z) /= ieee_signaling_nan) stop 100
  61     if (.not. ieee_is_nan(z)) stop 101
  62     if (isnansl(z) /= 1) stop 102
  63
  64     z = ieee_value(z, ieee_quiet_nan)
  65     if (ieee_class(z) /= ieee_quiet_nan) stop 103
  66     if (.not. ieee_is_nan(z)) stop 104
  67     if (isnansl(z) /= 0) stop 105
  68   end if
  69
  70 end program test