OpenCores
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/] [nan_inf_fmt.f90] - Blame information for rev 378

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

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