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

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