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

   1 ! { dg-do run }
   2 ! { dg-require-effective-target issignaling } */
   3 ! { dg-additional-sources signaling_1_c.c }
   4 ! { dg-additional-options "-w" }
   5 ! the -w option is needed to make f951 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     real(kind=c_float) function create_nansf () bind(c)
  15       import :: c_float
  16     end function
  17
  18     real(kind=c_double) function create_nans () bind(c)
  19       import :: c_double
  20     end function
  21
  22     real(kind=c_long_double) function create_nansl () bind(c)
  23       import :: c_long_double
  24     end function
  25   end interface
  26
  27   real(kind=c_float) :: x
  28   real(kind=c_double) :: y
  29   real(kind=c_long_double) :: z
  30
  31   if (ieee_support_nan(x)) then
  32     x = create_nansf()
  33     if (ieee_class(x) /= ieee_signaling_nan) stop 100
  34     if (.not. ieee_is_nan(x)) stop 101
  35     if (ieee_is_negative(x)) stop 102
  36     if (ieee_is_finite(x)) stop 103
  37     if (ieee_is_normal(x)) stop 104
  38     if (.not. ieee_unordered(x, x)) stop 105
  39     if (.not. ieee_unordered(x, 1._c_float)) stop 106
  40
  41     x = ieee_value(y, ieee_quiet_nan)
  42     if (ieee_class(x) /= ieee_quiet_nan) stop 107
  43     if (.not. ieee_is_nan(x)) stop 108
  44     if (ieee_is_negative(x)) stop 109
  45     if (ieee_is_finite(x)) stop 110
  46     if (ieee_is_normal(x)) stop 111
  47     if (.not. ieee_unordered(x, x)) stop 112
  48     if (.not. ieee_unordered(x, 1._c_double)) stop 113
  49   end if
  50
  51   if (ieee_support_nan(y)) then
  52     y = create_nans()
  53     if (ieee_class(y) /= ieee_signaling_nan) stop 200
  54     if (.not. ieee_is_nan(y)) stop 201
  55     if (ieee_is_negative(y)) stop 202
  56     if (ieee_is_finite(y)) stop 203
  57     if (ieee_is_normal(y)) stop 204
  58     if (.not. ieee_unordered(y, x)) stop 205
  59     if (.not. ieee_unordered(y, 1._c_double)) stop 206
  60
  61     y = ieee_value(y, ieee_quiet_nan)
  62     if (ieee_class(y) /= ieee_quiet_nan) stop 207
  63     if (.not. ieee_is_nan(y)) stop 208
  64     if (ieee_is_negative(y)) stop 209
  65     if (ieee_is_finite(y)) stop 210
  66     if (ieee_is_normal(y)) stop 211
  67     if (.not. ieee_unordered(y, y)) stop 212
  68     if (.not. ieee_unordered(y, 1._c_double)) stop 213
  69   end if
  70
  71   if (ieee_support_nan(z)) then
  72     z = create_nansl()
  73     if (ieee_class(z) /= ieee_signaling_nan) stop 300
  74     if (.not. ieee_is_nan(z)) stop 301
  75     if (ieee_is_negative(z)) stop 302
  76     if (ieee_is_finite(z)) stop 303
  77     if (ieee_is_normal(z)) stop 304
  78     if (.not. ieee_unordered(z, z)) stop 305
  79     if (.not. ieee_unordered(z, 1._c_long_double)) stop 306
  80
  81     z = ieee_value(y, ieee_quiet_nan)
  82     if (ieee_class(z) /= ieee_quiet_nan) stop 307
  83     if (.not. ieee_is_nan(z)) stop 308
  84     if (ieee_is_negative(z)) stop 309
  85     if (ieee_is_finite(z)) stop 310
  86     if (ieee_is_normal(z)) stop 311
  87     if (.not. ieee_unordered(z, z)) stop 312
  88     if (.not. ieee_unordered(z, 1._c_double)) stop 313
  89   end if
  90
  91 end program test