gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_set_exponent.f90

   1 !Program to test SET_EXPONENT intrinsic function.
   2
   3 program test_set_exponent
   4   call test_real4()
   5   call test_real8()
   6 end
   7
   8 subroutine test_real4()
   9   real*4 x,y
  10   integer*4 i,n
  11   equivalence(x, i)
  12
  13   n = -148
  14   x = 1024.0
  15   y = set_exponent (x, n)
  16   if ((y .ne. 0.0) .and. (exponent (y) .ne. n)) call abort()
  17
  18   n = 8
  19   x = 1024.0
  20   y = set_exponent (x, n)
  21   if (exponent (y) .ne. n) call abort()
  22
  23   n = 128
  24   i = 8388607
  25   x = transfer (i, x) ! z'007fffff' Positive denormalized floating-point.
  26   y = set_exponent (x, n)
  27   if (exponent (y) .ne. n) call abort()
  28
  29   n = -148
  30   x = -1024.0
  31   y = set_exponent (x, n)
  32   if  ((y .ne. 0.0) .and. (exponent (y) .ne. n)) call abort()
  33
  34   n = 8
  35   x = -1024.0
  36   y = set_exponent (x, n)
  37   if (y .ne. -128.0) call abort()
  38   if (exponent (y) .ne. n) call abort()
  39
  40   n = 128
  41   i = -2139095041
  42   x = transfer (i, x) ! z'807fffff' Negative denormalized floating-point.
  43   y = set_exponent (x, n)
  44   if (exponent (y) .ne. n) call abort()
  45
  46 end
  47
  48 subroutine test_real8()
  49   implicit none
  50   real*8 x, y
  51   integer*8 i, n
  52   equivalence(x, i)
  53
  54   n = -1073
  55   x = 1024.0_8
  56   y = set_exponent (x, n)
  57   if  ((y .ne. 0.0_8) .and. (exponent (y) .ne. n)) call abort()
  58
  59   n = 8
  60   x = 1024.0_8
  61   y = set_exponent (x, n)
  62   if (y .ne. 128.0) call abort()
  63   if (exponent (y) .ne. n) call abort()
  64
  65   n = 1024
  66   i = 4503599627370495_8
  67   x = transfer (i, x) !z'000fffffffffffff' Positive denormalized floating-point.
  68   y = set_exponent (x, n)
  69   if (exponent (y) .ne. n) call abort()
  70
  71   n = -1073
  72   x = -1024.0
  73   y = set_exponent (x, n)
  74   if ((y .ne. 0.0) .and. (exponent (y) .ne. n)) call abort()
  75
  76   n = 8
  77   x = -1024.0
  78   y = set_exponent (x, n)
  79   if (y .ne. -128.0) call abort()
  80   if (exponent (y) .ne. n) call abort()
  81
  82   n = 1024
  83   i = -9218868437227405313_8
  84   x = transfer (i, x)!z'800fffffffffffff' Negative denormalized floating-point.
  85   y = set_exponent (x, n)
  86   if (exponent (y) .ne. n) call abort()
  87 end