OSDN Git Service

d29cf533c24d2044581dfd080c7b10c0a401d95b
[pf3gnuchains/gcc-fork.git] / 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 subroutine test_real4()
8   real x,y
9   integer i,n
10   equivalence(x,i)
11
12   n = -148
13   x = 1024.0
14   y = set_exponent (x, n)
15   if ((y .ne. 0.0) .and. (exponent (y) .ne. n)) call abort()
16
17   n = 8
18   x = 1024.0
19   y = set_exponent (x, n)
20   if (exponent (y) .ne. n) call abort()
21
22   n = 128
23   i = o'00037777777'
24   y = set_exponent (x, n)
25   if (exponent (y) .ne. n) call abort()
26
27   n = -148
28   x = -1024.0
29   y = set_exponent (x, n)
30   if  ((y .ne. 0.0) .and. (exponent (y) .ne. n)) call abort()
31
32   n = 8
33   x = -1024.0
34   y = set_exponent (x, n)
35   if (y .ne. -128.0) call abort()
36   if (exponent (y) .ne. n) call abort()
37
38   n = 128
39   i = o'20037777777'
40   y = set_exponent (x, n)
41   if (exponent (y) .ne. n) call abort()
42
43 end
44
45 subroutine test_real8()
46   implicit none
47   real*8 x, y
48   integer*8 i, n, low
49   equivalence(x, i)
50
51   n = -1073
52   x = 1024.0_8
53   y = set_exponent (x, n)
54   if  ((y .ne. 0.0_8) .and. (exponent (y) .ne. n)) call abort()
55
56   n = 8
57   x = 1024.0_8
58   y = set_exponent (x, n)
59   if (y .ne. 128.0) call abort()
60   if (exponent (y) .ne. n) call abort()
61
62   n = 1024
63   low = z'ffffffff'
64   i = z'000fffff' 
65   i = ishft (i, 32) + low !'000fffffffffffff'
66   y = set_exponent (x, n)
67   low = z'fffffffe'
68   i = z'7fefffff' 
69   i = ishft (i, 32) + low
70   if (exponent (y) .ne. n) call abort()
71
72   n = -1073
73   x = -1024.0
74   y = set_exponent (x, n)
75   low = z'00000001'
76   if ((y .ne. 0.0) .and. (exponent (y) .ne. n)) call abort()
77
78   n = 8
79   x = -1024.0
80   y = set_exponent (x, n)
81   if (y .ne. -128.0) call abort()
82   if (exponent (y) .ne. n) call abort()
83
84   n = 1024
85   low = z'ffffffff'
86   i = z'800fffff' 
87   i = ishft (i, 32) + low !z'800fffffffffffff'
88   y = set_exponent (x, n)
89   if (exponent (y) .ne. n) call abort()
90
91 end