OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [nan_inf_fmt.f90] - Blame information for rev 867

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

Line No. Rev Author Line
1 149 jeremybenn
!pr 12839- F2003 formatting of Inf /Nan
2
       implicit none
3
       character*40 l
4
       character*12 fmt
5
       real zero, pos_inf, neg_inf, nan
6
       zero = 0.0
7
 
8
! need a better way of generating these floating point
9
! exceptional constants.
10
 
11
       pos_inf =  1.0/zero
12
       neg_inf = -1.0/zero
13
       nan = zero/zero
14
 
15
! check a field width = 0
16
       fmt = '(F0.0)'
17
       write(l,fmt=fmt)pos_inf
18
       if (l.ne.'+Inf') call abort
19
       write(l,fmt=fmt)neg_inf
20
       if (l.ne.'-Inf') call abort
21
       write(l,fmt=fmt)nan
22
       if (l.ne.' NaN') call abort
23
 
24
! check a field width < 3
25
       fmt = '(F2.0)'
26
       write(l,fmt=fmt)pos_inf
27
       if (l.ne.'**') call abort
28
       write(l,fmt=fmt)neg_inf
29
       if (l.ne.'**') call abort
30
       write(l,fmt=fmt)nan
31
       if (l.ne.'**') call abort
32
 
33
! check a field width = 3
34
       fmt = '(F3.0)'
35
       write(l,fmt=fmt)pos_inf
36
       if (l.ne.'Inf') call abort
37
       write(l,fmt=fmt)neg_inf
38
       if (l.ne.'***') call abort
39
       write(l,fmt=fmt)nan
40
       if (l.ne.'NaN') call abort
41
 
42
! check a field width > 3
43
       fmt = '(F4.0)'
44
       write(l,fmt=fmt)pos_inf
45
       if (l.ne.'+Inf') call abort
46
       write(l,fmt=fmt)neg_inf
47
       if (l.ne.'-Inf') call abort
48
       write(l,fmt=fmt)nan
49
       if (l.ne.' NaN') call abort
50
 
51
! check a field width = 7
52
       fmt = '(F7.0)'
53
       write(l,fmt=fmt)pos_inf
54
       if (l.ne.'   +Inf') call abort
55
       write(l,fmt=fmt)neg_inf
56
       if (l.ne.'   -Inf') call abort
57
       write(l,fmt=fmt)nan
58
       if (l.ne.'    NaN') call abort
59
 
60
! check a field width = 8
61
       fmt = '(F8.0)'
62
       write(l,fmt=fmt)pos_inf
63
       if (l.ne.'    +Inf') call abort
64
       write(l,fmt=fmt)neg_inf
65
       if (l.ne.'    -Inf') call abort
66
       write(l,fmt=fmt)nan
67
       if (l.ne.'     NaN') call abort
68
 
69
! check a field width = 9
70
       fmt = '(F9.0)'
71
       write(l,fmt=fmt)pos_inf
72
       if (l.ne.'+Infinity') call abort
73
       write(l,fmt=fmt)neg_inf
74
       if (l.ne.'-Infinity') call abort
75
       write(l,fmt=fmt)nan
76
       if (l.ne.'      NaN') call abort
77
 
78
! check a field width = 14
79
       fmt = '(F14.0)'
80
       write(l,fmt=fmt)pos_inf
81
       if (l.ne.'     +Infinity') call abort
82
       write(l,fmt=fmt)neg_inf
83
       if (l.ne.'     -Infinity') call abort
84
       write(l,fmt=fmt)nan
85
       if (l.ne.'           NaN') call abort
86
       end
87
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.