OSDN Git Service

2011-01-29 Jerry DeLisle <jvdelisle@gcc.gnu.org>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.fortran-torture / execute / nan_inf_fmt.f90
1 !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