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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [nan_inf_fmt.f90] - Blame information for rev 695

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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