OSDN Git Service

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