1 files changed, 91 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_set_exponent.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_set_exponent.f90
new file mode 100644
index 00000000000..da84ea7d723
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_set_exponent.f90
@@ -0,0 +1,91 @@
+!Program to test SET_EXPONENT intrinsic function.
+
+program test_set_exponent
+  call test_real4()
+  call test_real8()
+end
+subroutine test_real4()
+  real x,y
+  integer i,n
+  equivalence(x,i)
+
+  n = -148
+  x = 1024.0
+  y = set_exponent (x, n)
+  if (exponent (y) .ne. n) call abort()
+
+  n = 8
+  x = 1024.0
+  y = set_exponent (x, n)
+  if (exponent (y) .ne. n) call abort()
+
+  n = 128
+  i = o'00037777777'
+  y = set_exponent (x, n)
+  if (exponent (y) .ne. n) call abort()
+
+  n = -148
+  x = -1024.0
+  y = set_exponent (x, n)
+  if (exponent (y) .ne. n) call abort()
+
+  n = 8
+  x = -1024.0
+  y = set_exponent (x, n)
+  if (y .ne. -128.0) call abort()
+  if (exponent (y) .ne. n) call abort()
+
+  n = 128
+  i = o'20037777777'
+  y = set_exponent (x, n)
+  if (exponent (y) .ne. n) call abort()
+
+end
+
+subroutine test_real8()
+  implicit none
+  real*8 x, y
+  integer*8 i, n, low
+  equivalence(x, i)
+
+  n = -1073
+  x = 1024.0_8
+  y = set_exponent (x, n)
+  if (exponent (y) .ne. n) call abort()
+
+  n = 8
+  x = 1024.0_8
+  y = set_exponent (x, n)
+  if (y .ne. 128.0) call abort()
+  if (exponent (y) .ne. n) call abort()
+
+  n = 1024
+  low = z'ffffffff'
+  i = z'000fffff' 
+  i = ishft (i, 32) + low !'000fffffffffffff'
+  y = set_exponent (x, n)
+  low = z'fffffffe'
+  i = z'7fefffff' 
+  i = ishft (i, 32) + low
+  if (exponent (y) .ne. n) call abort()
+
+  n = -1073
+  x = -1024.0
+  y = set_exponent (x, n)
+  low = z'00000001'
+  if (exponent (y) .ne. n) call abort()
+
+  n = 8
+  x = -1024.0
+  y = set_exponent (x, n)
+  if (y .ne. -128.0) call abort()
+  if (exponent (y) .ne. n) call abort()
+
+  n = 1024
+  low = z'ffffffff'
+  i = z'800fffff' 
+  i = ishft (i, 32) + low !z'800fffffffffffff'
+  y = set_exponent (x, n)
+  if (exponent (y) .ne. n) call abort()
+
+end