URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [intrinsic_set_exponent.f90] - Blame information for rev 308

Go to most recent revision | Details | Compare with Previous | View Log


!Program to test SET_EXPONENT intrinsic function.
 
program test_set_exponent
  call test_real4()
  call test_real8()
end
 
subroutine test_real4()
  real*4 x,y
  integer*4 i,n
  equivalence(x, i)
 
  n = -148
  x = 1024.0
  y = set_exponent (x, n)
  if ((y .ne. 0.0) .and. (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 = 8388607
  x = transfer (i, x) ! z'007fffff' Positive denormalized floating-point.
  y = set_exponent (x, n)
  if (exponent (y) .ne. n) call abort()
 
  n = -148
  x = -1024.0
  y = set_exponent (x, n)
  if  ((y .ne. 0.0) .and. (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 = -2139095041
  x = transfer (i, x) ! z'807fffff' Negative denormalized floating-point.
  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
  equivalence(x, i)
 
  n = -1073
  x = 1024.0_8
  y = set_exponent (x, n)
  if  ((y .ne. 0.0_8) .and. (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
  i = 4503599627370495_8
  x = transfer (i, x) !z'000fffffffffffff' Positive denormalized floating-point.
  y = set_exponent (x, n)
  if (exponent (y) .ne. n) call abort()
 
  n = -1073
  x = -1024.0
  y = set_exponent (x, n)
  if ((y .ne. 0.0) .and. (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
  i = -9218868437227405313_8
  x = transfer (i, x)!z'800fffffffffffff' Negative denormalized floating-point.
  y = set_exponent (x, n)
  if (exponent (y) .ne. n) call abort()
end

Line No.	Rev	Author	Line
1	303	jeremybenn	`!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`

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [intrinsic_set_exponent.f90] - Blame information for rev 308