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

   1 ! { dg-do run }
   2
   3   use, intrinsic :: ieee_features
   4   use, intrinsic :: ieee_exceptions
   5   use, intrinsic :: ieee_arithmetic
   6   implicit none
   7
   8   interface check_equal
   9     procedure check_equal_float, check_equal_double
  10   end interface
  11
  12   interface check_not_equal
  13     procedure check_not_equal_float, check_not_equal_double
  14   end interface
  15
  16   real :: sx1, sx2, sx3
  17   double precision :: dx1, dx2, dx3
  18   type(ieee_round_type) :: mode
  19
  20   ! Test IEEE_COPY_SIGN
  21   sx1 = 1.3
  22   if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 1
  23   if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 2
  24   if (ieee_copy_sign(sx1, 1.) /= sx1) STOP 3
  25   if (ieee_copy_sign(sx1, -1.) /= -sx1) STOP 4
  26   sx1 = huge(sx1)
  27   if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 5
  28   if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 6
  29   if (ieee_copy_sign(sx1, 1.) /= sx1) STOP 7
  30   if (ieee_copy_sign(sx1, -1.) /= -sx1) STOP 8
  31   sx1 = ieee_value(sx1, ieee_positive_inf)
  32   if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 9
  33   if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 10
  34   if (ieee_copy_sign(sx1, 1.) /= sx1) STOP 11
  35   if (ieee_copy_sign(sx1, -1.) /= -sx1) STOP 12
  36   sx1 = tiny(sx1)
  37   if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 13
  38   if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 14
  39   if (ieee_copy_sign(sx1, 1.) /= sx1) STOP 15
  40   if (ieee_copy_sign(sx1, -1.) /= -sx1) STOP 16
  41   sx1 = tiny(sx1)
  42   sx1 = sx1 / 101
  43   if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 17
  44   if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 18
  45   if (ieee_copy_sign(sx1, 1.) /= sx1) STOP 19
  46   if (ieee_copy_sign(sx1, -1.) /= -sx1) STOP 20
  47
  48   sx1 = -1.3
  49   if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 21
  50   if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 22
  51   if (ieee_copy_sign(sx1, 1.) /= abs(sx1)) STOP 23
  52   if (ieee_copy_sign(sx1, -1.) /= -abs(sx1)) STOP 24
  53   sx1 = -huge(sx1)
  54   if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 25
  55   if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 26
  56   if (ieee_copy_sign(sx1, 1.) /= abs(sx1)) STOP 27
  57   if (ieee_copy_sign(sx1, -1.) /= -abs(sx1)) STOP 28
  58   sx1 = ieee_value(sx1, ieee_negative_inf)
  59   if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 29
  60   if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 30
  61   if (ieee_copy_sign(sx1, 1.) /= abs(sx1)) STOP 31
  62   if (ieee_copy_sign(sx1, -1.) /= -abs(sx1)) STOP 32
  63   sx1 = -tiny(sx1)
  64   if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 33
  65   if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 34
  66   if (ieee_copy_sign(sx1, 1.) /= abs(sx1)) STOP 35
  67   if (ieee_copy_sign(sx1, -1.) /= -abs(sx1)) STOP 36
  68   sx1 = -tiny(sx1)
  69   sx1 = sx1 / 101
  70   if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 37
  71   if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 38
  72   if (ieee_copy_sign(sx1, 1.) /= abs(sx1)) STOP 39
  73   if (ieee_copy_sign(sx1, -1.) /= -abs(sx1)) STOP 40
  74
  75   if (ieee_class(ieee_copy_sign(0., -1.)) /= ieee_negative_zero) STOP 41
  76   if (ieee_class(ieee_copy_sign(-0., -1.)) /= ieee_negative_zero) STOP 42
  77   if (ieee_class(ieee_copy_sign(0., 1.)) /= ieee_positive_zero) STOP 43
  78   if (ieee_class(ieee_copy_sign(-0., 1.)) /= ieee_positive_zero) STOP 44
  79
  80   sx1 = ieee_value(0., ieee_quiet_nan)
  81   if (ieee_class(ieee_copy_sign(sx1, 1.)) /= ieee_quiet_nan) STOP 45
  82   if (ieee_class(ieee_copy_sign(sx1, -1.)) /= ieee_quiet_nan) STOP 46
  83
  84   dx1 = 1.3
  85   if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 47
  86   if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 48
  87   if (ieee_copy_sign(dx1, 1.) /= dx1) STOP 49
  88   if (ieee_copy_sign(dx1, -1.d0) /= -dx1) STOP 50
  89   dx1 = huge(dx1)
  90   if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 51
  91   if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 52
  92   if (ieee_copy_sign(dx1, 1.d0) /= dx1) STOP 53
  93   if (ieee_copy_sign(dx1, -1.) /= -dx1) STOP 54
  94   dx1 = ieee_value(dx1, ieee_positive_inf)
  95   if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 55
  96   if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 56
  97   if (ieee_copy_sign(dx1, 1.) /= dx1) STOP 57
  98   if (ieee_copy_sign(dx1, -1.d0) /= -dx1) STOP 58
  99   dx1 = tiny(dx1)
 100   if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 59
 101   if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 60
 102   if (ieee_copy_sign(dx1, 1.d0) /= dx1) STOP 61
 103   if (ieee_copy_sign(dx1, -1.) /= -dx1) STOP 62
 104   dx1 = tiny(dx1)
 105   dx1 = dx1 / 101
 106   if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 63
 107   if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 64
 108   if (ieee_copy_sign(dx1, 1.) /= dx1) STOP 65
 109   if (ieee_copy_sign(dx1, -1.d0) /= -dx1) STOP 66
 110
 111   dx1 = -1.3d0
 112   if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 67
 113   if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 68
 114   if (ieee_copy_sign(dx1, 1.d0) /= abs(dx1)) STOP 69
 115   if (ieee_copy_sign(dx1, -1.) /= -abs(dx1)) STOP 70
 116   dx1 = -huge(dx1)
 117   if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 71
 118   if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 72
 119   if (ieee_copy_sign(dx1, 1.) /= abs(dx1)) STOP 73
 120   if (ieee_copy_sign(dx1, -1.d0) /= -abs(dx1)) STOP 74
 121   dx1 = ieee_value(dx1, ieee_negative_inf)
 122   if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 75
 123   if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 76
 124   if (ieee_copy_sign(dx1, 1.d0) /= abs(dx1)) STOP 77
 125   if (ieee_copy_sign(dx1, -1.) /= -abs(dx1)) STOP 78
 126   dx1 = -tiny(dx1)
 127   if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 79
 128   if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 80
 129   if (ieee_copy_sign(dx1, 1.) /= abs(dx1)) STOP 81
 130   if (ieee_copy_sign(dx1, -1.d0) /= -abs(dx1)) STOP 82
 131   dx1 = -tiny(dx1)
 132   dx1 = dx1 / 101
 133   if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 83
 134   if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 84
 135   if (ieee_copy_sign(dx1, 1.d0) /= abs(dx1)) STOP 85
 136   if (ieee_copy_sign(dx1, -1.) /= -abs(dx1)) STOP 86
 137
 138   if (ieee_class(ieee_copy_sign(0.d0, -1.)) /= ieee_negative_zero) STOP 87
 139   if (ieee_class(ieee_copy_sign(-0.d0, -1.)) /= ieee_negative_zero) STOP 88
 140   if (ieee_class(ieee_copy_sign(0.d0, 1.)) /= ieee_positive_zero) STOP 89
 141   if (ieee_class(ieee_copy_sign(-0.d0, 1.)) /= ieee_positive_zero) STOP 90
 142
 143   dx1 = ieee_value(0.d0, ieee_quiet_nan)
 144   if (ieee_class(ieee_copy_sign(dx1, 1.d0)) /= ieee_quiet_nan) STOP 91
 145   if (ieee_class(ieee_copy_sign(dx1, -1.)) /= ieee_quiet_nan) STOP 92
 146
 147   ! Test IEEE_LOGB
 148
 149   if (ieee_logb(1.17) /= exponent(1.17) - 1) STOP 93
 150   if (ieee_logb(-1.17) /= exponent(-1.17) - 1) STOP 94
 151   if (ieee_logb(huge(sx1)) /= exponent(huge(sx1)) - 1) STOP 95
 152   if (ieee_logb(-huge(sx1)) /= exponent(-huge(sx1)) - 1) STOP 96
 153   if (ieee_logb(tiny(sx1)) /= exponent(tiny(sx1)) - 1) STOP 97
 154   if (ieee_logb(-tiny(sx1)) /= exponent(-tiny(sx1)) - 1) STOP 98
 155
 156   if (ieee_class(ieee_logb(0.)) /= ieee_negative_inf) STOP 99
 157   if (ieee_class(ieee_logb(-0.)) /= ieee_negative_inf) STOP 100
 158
 159   sx1 = ieee_value(sx1, ieee_positive_inf)
 160   if (ieee_class(ieee_logb(sx1)) /= ieee_positive_inf) STOP 101
 161   if (ieee_class(ieee_logb(-sx1)) /= ieee_positive_inf) STOP 102
 162
 163   sx1 = ieee_value(sx1, ieee_quiet_nan)
 164   if (ieee_class(ieee_logb(sx1)) /= ieee_quiet_nan) STOP 103
 165
 166   if (ieee_logb(1.17d0) /= exponent(1.17d0) - 1) STOP 104
 167   if (ieee_logb(-1.17d0) /= exponent(-1.17d0) - 1) STOP 105
 168   if (ieee_logb(huge(dx1)) /= exponent(huge(dx1)) - 1) STOP 106
 169   if (ieee_logb(-huge(dx1)) /= exponent(-huge(dx1)) - 1) STOP 107
 170   if (ieee_logb(tiny(dx1)) /= exponent(tiny(dx1)) - 1) STOP 108
 171   if (ieee_logb(-tiny(dx1)) /= exponent(-tiny(dx1)) - 1) STOP 109
 172
 173   if (ieee_class(ieee_logb(0.d0)) /= ieee_negative_inf) STOP 110
 174   if (ieee_class(ieee_logb(-0.d0)) /= ieee_negative_inf) STOP 111
 175
 176   dx1 = ieee_value(dx1, ieee_positive_inf)
 177   if (ieee_class(ieee_logb(dx1)) /= ieee_positive_inf) STOP 112
 178   if (ieee_class(ieee_logb(-dx1)) /= ieee_positive_inf) STOP 113
 179
 180   dx1 = ieee_value(dx1, ieee_quiet_nan)
 181   if (ieee_class(ieee_logb(dx1)) /= ieee_quiet_nan) STOP 114
 182
 183   ! Test IEEE_NEXT_AFTER
 184
 185   if (ieee_next_after(0.12, 1.0) /= nearest(0.12, 1.0)) STOP 115
 186   if (ieee_next_after(0.12, -1.0) /= nearest(0.12, -1.0)) STOP 116
 187
 188   sx1 = 0.12
 189   if (ieee_next_after(sx1, sx1) /= sx1) STOP 117
 190   sx1 = -0.12
 191   if (ieee_next_after(sx1, sx1) /= sx1) STOP 118
 192   sx1 = huge(sx1)
 193   if (ieee_next_after(sx1, sx1) /= sx1) STOP 119
 194   sx1 = tiny(sx1)
 195   if (ieee_next_after(sx1, sx1) /= sx1) STOP 120
 196   sx1 = 0
 197   if (ieee_next_after(sx1, sx1) /= sx1) STOP 121
 198   sx1 = ieee_value(sx1, ieee_negative_inf)
 199   if (ieee_next_after(sx1, sx1) /= sx1) STOP 122
 200   sx1 = ieee_value(sx1, ieee_quiet_nan)
 201   if (ieee_class(ieee_next_after(sx1, sx1)) /= ieee_quiet_nan) STOP 123
 202
 203   if (ieee_next_after(0., 1.0) <= 0) STOP 124
 204   if (ieee_next_after(0., -1.0) >= 0) STOP 125
 205   sx1 = ieee_next_after(huge(sx1), ieee_value(sx1, ieee_negative_inf))
 206   if (.not. sx1 < huge(sx1)) STOP 126
 207   sx1 = ieee_next_after(huge(sx1), ieee_value(sx1, ieee_positive_inf))
 208   if (ieee_class(sx1) /= ieee_positive_inf) STOP 127
 209   sx1 = ieee_next_after(-tiny(sx1), 1.0)
 210   if (ieee_class(sx1) /= ieee_negative_denormal) STOP 128
 211
 212   if (ieee_next_after(0.12d0, 1.0d0) /= nearest(0.12d0, 1.0)) STOP 129
 213   if (ieee_next_after(0.12d0, -1.0) /= nearest(0.12d0, -1.0)) STOP 130
 214
 215   dx1 = 0.12
 216   if (ieee_next_after(dx1, dx1) /= dx1) STOP 131
 217   dx1 = -0.12
 218   if (ieee_next_after(dx1, dx1) /= dx1) STOP 132
 219   dx1 = huge(dx1)
 220   if (ieee_next_after(dx1, dx1) /= dx1) STOP 133
 221   dx1 = tiny(dx1)
 222   if (ieee_next_after(dx1, dx1) /= dx1) STOP 134
 223   dx1 = 0
 224   if (ieee_next_after(dx1, dx1) /= dx1) STOP 135
 225   dx1 = ieee_value(dx1, ieee_negative_inf)
 226   if (ieee_next_after(dx1, dx1) /= dx1) STOP 136
 227   dx1 = ieee_value(dx1, ieee_quiet_nan)
 228   if (ieee_class(ieee_next_after(dx1, dx1)) /= ieee_quiet_nan) STOP 137
 229
 230   if (ieee_next_after(0.d0, 1.0) <= 0) STOP 138
 231   if (ieee_next_after(0.d0, -1.0d0) >= 0) STOP 139
 232   dx1 = ieee_next_after(huge(dx1), ieee_value(dx1, ieee_negative_inf))
 233   if (.not. dx1 < huge(dx1)) STOP 140
 234   dx1 = ieee_next_after(huge(dx1), ieee_value(dx1, ieee_positive_inf))
 235   if (ieee_class(dx1) /= ieee_positive_inf) STOP 141
 236   dx1 = ieee_next_after(-tiny(dx1), 1.0d0)
 237   if (ieee_class(dx1) /= ieee_negative_denormal) STOP 142
 238
 239   ! Test IEEE_REM
 240
 241   if (ieee_rem(4.0, 3.0) /= 1.0) STOP 143
 242   if (ieee_rem(-4.0, 3.0) /= -1.0) STOP 144
 243   if (ieee_rem(2.0, 3.0d0) /= -1.0d0) STOP 145
 244   if (ieee_rem(-2.0, 3.0d0) /= 1.0d0) STOP 146
 245   if (ieee_rem(2.0d0, 3.0d0) /= -1.0d0) STOP 147
 246   if (ieee_rem(-2.0d0, 3.0d0) /= 1.0d0) STOP 148
 247
 248   if (ieee_class(ieee_rem(ieee_value(0., ieee_quiet_nan), 1.0)) &
 249       /= ieee_quiet_nan) STOP 149
 250   if (ieee_class(ieee_rem(1.0, ieee_value(0.d0, ieee_quiet_nan))) &
 251       /= ieee_quiet_nan) STOP 150
 252
 253   if (ieee_class(ieee_rem(ieee_value(0., ieee_positive_inf), 1.0)) &
 254       /= ieee_quiet_nan) STOP 151
 255   if (ieee_class(ieee_rem(ieee_value(0.d0, ieee_negative_inf), 1.0)) &
 256       /= ieee_quiet_nan) STOP 152
 257   if (ieee_rem(-1.0, ieee_value(0., ieee_positive_inf)) &
 258       /= -1.0) STOP 153
 259   if (ieee_rem(1.0, ieee_value(0.d0, ieee_negative_inf)) &
 260       /= 1.0) STOP 154
 261
 262
 263   ! Test IEEE_RINT
 264
 265   if (ieee_support_rounding (ieee_nearest, sx1)) then
 266     call ieee_get_rounding_mode (mode)
 267     call ieee_set_rounding_mode (ieee_nearest)
 268     sx1 = 7 / 3.
 269     sx1 = ieee_rint (sx1)
 270     call ieee_set_rounding_mode (mode)
 271     if (sx1 /= 2) STOP 155
 272   end if
 273
 274   if (ieee_support_rounding (ieee_up, sx1)) then
 275     call ieee_get_rounding_mode (mode)
 276     call ieee_set_rounding_mode (ieee_up)
 277     sx1 = 7 / 3.
 278     sx1 = ieee_rint (sx1)
 279     call ieee_set_rounding_mode (mode)
 280     if (sx1 /= 3) STOP 156
 281   end if
 282
 283   if (ieee_support_rounding (ieee_down, sx1)) then
 284     call ieee_get_rounding_mode (mode)
 285     call ieee_set_rounding_mode (ieee_down)
 286     sx1 = 7 / 3.
 287     sx1 = ieee_rint (sx1)
 288     call ieee_set_rounding_mode (mode)
 289     if (sx1 /= 2) STOP 157
 290   end if
 291
 292   if (ieee_support_rounding (ieee_to_zero, sx1)) then
 293     call ieee_get_rounding_mode (mode)
 294     call ieee_set_rounding_mode (ieee_to_zero)
 295     sx1 = 7 / 3.
 296     sx1 = ieee_rint (sx1)
 297     call ieee_set_rounding_mode (mode)
 298     if (sx1 /= 2) STOP 158
 299   end if
 300
 301   if (ieee_class(ieee_rint(0.)) /= ieee_positive_zero) STOP 159
 302   if (ieee_class(ieee_rint(-0.)) /= ieee_negative_zero) STOP 160
 303
 304   if (ieee_support_rounding (ieee_nearest, dx1)) then
 305     call ieee_get_rounding_mode (mode)
 306     call ieee_set_rounding_mode (ieee_nearest)
 307     dx1 = 7 / 3.d0
 308     dx1 = ieee_rint (dx1)
 309     call ieee_set_rounding_mode (mode)
 310     if (dx1 /= 2) STOP 161
 311   end if
 312
 313   if (ieee_support_rounding (ieee_up, dx1)) then
 314     call ieee_get_rounding_mode (mode)
 315     call ieee_set_rounding_mode (ieee_up)
 316     dx1 = 7 / 3.d0
 317     dx1 = ieee_rint (dx1)
 318     call ieee_set_rounding_mode (mode)
 319     if (dx1 /= 3) STOP 162
 320   end if
 321
 322   if (ieee_support_rounding (ieee_down, dx1)) then
 323     call ieee_get_rounding_mode (mode)
 324     call ieee_set_rounding_mode (ieee_down)
 325     dx1 = 7 / 3.d0
 326     dx1 = ieee_rint (dx1)
 327     call ieee_set_rounding_mode (mode)
 328     if (dx1 /= 2) STOP 163
 329   end if
 330
 331   if (ieee_support_rounding (ieee_to_zero, dx1)) then
 332     call ieee_get_rounding_mode (mode)
 333     call ieee_set_rounding_mode (ieee_to_zero)
 334     dx1 = 7 / 3.d0
 335     dx1 = ieee_rint (dx1)
 336     call ieee_set_rounding_mode (mode)
 337     if (dx1 /= 2) STOP 164
 338   end if
 339
 340   if (ieee_class(ieee_rint(0.d0)) /= ieee_positive_zero) STOP 165
 341   if (ieee_class(ieee_rint(-0.d0)) /= ieee_negative_zero) STOP 166
 342
 343   ! Test IEEE_SCALB
 344
 345   sx1 = 1
 346   if (ieee_scalb(sx1, 2) /= 4.) STOP 167
 347   if (ieee_scalb(-sx1, 2) /= -4.) STOP 168
 348   if (ieee_scalb(sx1, -2) /= 1/4.) STOP 169
 349   if (ieee_scalb(-sx1, -2) /= -1/4.) STOP 170
 350   if (ieee_class(ieee_scalb(sx1, huge(0))) /= ieee_positive_inf) STOP 171
 351   if (ieee_class(ieee_scalb(-sx1, huge(0))) /= ieee_negative_inf) STOP 172
 352   if (ieee_class(ieee_scalb(sx1, -huge(0))) /= ieee_positive_zero) STOP 173
 353   if (ieee_class(ieee_scalb(-sx1, -huge(0))) /= ieee_negative_zero) STOP 174
 354
 355   sx1 = ieee_value(sx1, ieee_quiet_nan)
 356   if (ieee_class(ieee_scalb(sx1, 1)) /= ieee_quiet_nan) STOP 175
 357   sx1 = ieee_value(sx1, ieee_positive_inf)
 358   if (ieee_class(ieee_scalb(sx1, -42)) /= ieee_positive_inf) STOP 176
 359   sx1 = ieee_value(sx1, ieee_negative_inf)
 360   if (ieee_class(ieee_scalb(sx1, -42)) /= ieee_negative_inf) STOP 177
 361
 362   dx1 = 1
 363   if (ieee_scalb(dx1, 2) /= 4.d0) STOP 178
 364   if (ieee_scalb(-dx1, 2) /= -4.d0) STOP 179
 365   if (ieee_scalb(dx1, -2) /= 1/4.d0) STOP 180
 366   if (ieee_scalb(-dx1, -2) /= -1/4.d0) STOP 181
 367   if (ieee_class(ieee_scalb(dx1, huge(0))) /= ieee_positive_inf) STOP 182
 368   if (ieee_class(ieee_scalb(-dx1, huge(0))) /= ieee_negative_inf) STOP 183
 369   if (ieee_class(ieee_scalb(dx1, -huge(0))) /= ieee_positive_zero) STOP 184
 370   if (ieee_class(ieee_scalb(-dx1, -huge(0))) /= ieee_negative_zero) STOP 185
 371
 372   dx1 = ieee_value(dx1, ieee_quiet_nan)
 373   if (ieee_class(ieee_scalb(dx1, 1)) /= ieee_quiet_nan) STOP 186
 374   dx1 = ieee_value(dx1, ieee_positive_inf)
 375   if (ieee_class(ieee_scalb(dx1, -42)) /= ieee_positive_inf) STOP 187
 376   dx1 = ieee_value(dx1, ieee_negative_inf)
 377   if (ieee_class(ieee_scalb(dx1, -42)) /= ieee_negative_inf) STOP 188
 378
 379 contains
 380
 381   subroutine check_equal_float (x, y)
 382     real, intent(in) :: x, y
 383     if (x /= y) then
 384       print *, x, y
 385       STOP 189
 386     end if
 387   end subroutine
 388
 389   subroutine check_equal_double (x, y)
 390     double precision, intent(in) :: x, y
 391     if (x /= y) then
 392       print *, x, y
 393       STOP 190
 394     end if
 395   end subroutine
 396
 397   subroutine check_not_equal_float (x, y)
 398     real, intent(in) :: x, y
 399     if (x == y) then
 400       print *, x, y
 401       STOP 191
 402     end if
 403   end subroutine
 404
 405   subroutine check_not_equal_double (x, y)
 406     double precision, intent(in) :: x, y
 407     if (x == y) then
 408       print *, x, y
 409       STOP 192
 410     end if
 411   end subroutine
 412
 413 end