?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
ieee_9.f90: XFAIL on arm*-*-gnueabi[hf].
[official-gcc.git] / gcc / testsuite / gfortran.dg / fmt_pf.f90
blob11171b278ae76fe3432d372647068d122c7e5579
1 ! { dg-do run }
2 ! PR70235 Incorrect output with PF format.
3 ! Test case provided by Antoine Gardeux.
4 program pr70235
5 use ISO_FORTRAN_ENV
6 implicit none
7 integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]]
8 logical :: l_skip(4) = .false.
9 integer :: i
10 integer :: n_tst = 0, n_cnt = 0, n_skip = 0
11 character(len=20) :: s, s1
12
13 ! Check that the default rounding mode is to nearest and to even on tie.
14 do i=1,size(real_kinds)
15 if (i == 1) then
16 write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(1)), &
17 real(9.49999905,kind=j(1)), &
18 real(9.5,kind=j(1)), real(8.5,kind=j(1))
19 write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(1)), &
20 real(98765.0,kind=j(1))
21 else if (i == 2) then
22 write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(2)), &
23 real(9.49999905,kind=j(2)), &
24 real(9.5,kind=j(2)), real(8.5,kind=j(2))
25 write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(2)), &
26 real(98765.0,kind=j(2))
27 else if (i == 3) then
28 write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(3)), &
29 real(9.49999905,kind=j(3)), &
30 real(9.5,kind=j(3)), real(8.5,kind=j(3))
31 write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(3)), &
32 real(98765.0,kind=j(3))
33 else if (i == 4) then
34 write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(4)), &
35 real(9.49999905,kind=j(4)), &
36 real(9.5,kind=j(4)), real(8.5,kind=j(4))
37 write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(4)), &
38 real(98765.0,kind=j(4))
39 end if
40 if (s /= '-9.5 9.5 10. 8.' .or. s1 /= ' 987.4E+03 98.76E+03') then
41 l_skip(i) = .true.
42 ! print "('Unsupported rounding for real(',i0,')')", j(i)
43 end if
44 end do
45
46
47 ! Original test.
48 call checkfmt("(-6PF8.3)", 1.0e4, " 0.010")
49 call checkfmt("(-6PF8.3)", 0.0, " 0.000")
50
51 ! Test for the bug in comment 6.
52 call checkfmt("(-8pf18.3)", 643.125, " 0.000")
53 call checkfmt("(-7pf18.3)", 643.125, " 0.000")
54 call checkfmt("(-6pf18.3)", 643.125, " 0.001")
55 call checkfmt("(-5pf18.3)", 643.125, " 0.006")
56 call checkfmt("(-4pf18.3)", 643.125, " 0.064")
57 call checkfmt("(-3pf18.3)", 643.125, " 0.643")
58 call checkfmt("(-2pf18.3)", 643.125, " 6.431")
59 call checkfmt("(-1pf18.3)", 643.125, " 64.312")
60 call checkfmt("( 0pf18.3)", 643.125, " 643.125")
61
62 call checkfmt("(ru,-8pf18.3)", 643.125, " 0.001")
63 call checkfmt("(ru,-7pf18.3)", 643.125, " 0.001")
64 call checkfmt("(ru,-6pf18.3)", 643.125, " 0.001")
65 call checkfmt("(ru,-5pf18.3)", 643.125, " 0.007")
66 call checkfmt("(ru,-4pf18.3)", 643.125, " 0.065")
67 call checkfmt("(ru,-3pf18.3)", 643.125, " 0.644")
68 call checkfmt("(ru,-2pf18.3)", 643.125, " 6.432")
69 call checkfmt("(ru,-1pf18.3)", 643.125, " 64.313")
70 call checkfmt("(ru, 0pf18.3)", 643.125, " 643.125")
71
72 call checkfmt("(rd,-8pf18.3)", 643.125, " 0.000")
73 call checkfmt("(rd,-7pf18.3)", 643.125, " 0.000")
74 call checkfmt("(rd,-6pf18.3)", 643.125, " 0.000")
75 call checkfmt("(rd,-5pf18.3)", 643.125, " 0.006")
76 call checkfmt("(rd,-4pf18.3)", 643.125, " 0.064")
77 call checkfmt("(rd,-3pf18.3)", 643.125, " 0.643")
78 call checkfmt("(rd,-2pf18.3)", 643.125, " 6.431")
79 call checkfmt("(rd,-1pf18.3)", 643.125, " 64.312")
80 call checkfmt("(rd, 0pf18.3)", 643.125, " 643.125")
81
82 call checkfmt("(rz,-8pf18.3)", 643.125, " 0.000")
83 call checkfmt("(rz,-7pf18.3)", 643.125, " 0.000")
84 call checkfmt("(rz,-6pf18.3)", 643.125, " 0.000")
85 call checkfmt("(rz,-5pf18.3)", 643.125, " 0.006")
86 call checkfmt("(rz,-4pf18.3)", 643.125, " 0.064")
87 call checkfmt("(rz,-3pf18.3)", 643.125, " 0.643")
88 call checkfmt("(rz,-2pf18.3)", 643.125, " 6.431")
89 call checkfmt("(rz,-1pf18.3)", 643.125, " 64.312")
90 call checkfmt("(rz, 0pf18.3)", 643.125, " 643.125")
91
92 call checkfmt("(rc,-8pf18.3)", 643.125, " 0.000")
93 call checkfmt("(rc,-7pf18.3)", 643.125, " 0.000")
94 call checkfmt("(rc,-6pf18.3)", 643.125, " 0.001")
95 call checkfmt("(rc,-5pf18.3)", 643.125, " 0.006")
96 call checkfmt("(rc,-4pf18.3)", 643.125, " 0.064")
97 call checkfmt("(rc,-3pf18.3)", 643.125, " 0.643")
98 call checkfmt("(rc,-2pf18.3)", 643.125, " 6.431")
99 call checkfmt("(rc,-1pf18.3)", 643.125, " 64.313")
100 call checkfmt("(rc, 0pf18.3)", 643.125, " 643.125")
101
102 call checkfmt("(rn,-8pf18.3)", 643.125, " 0.000")
103 call checkfmt("(rn,-7pf18.3)", 643.125, " 0.000")
104 call checkfmt("(rn,-6pf18.3)", 643.125, " 0.001")
105 call checkfmt("(rn,-5pf18.3)", 643.125, " 0.006")
106 call checkfmt("(rn,-4pf18.3)", 643.125, " 0.064")
107 call checkfmt("(rn,-3pf18.3)", 643.125, " 0.643")
108 call checkfmt("(rn,-2pf18.3)", 643.125, " 6.431")
109 call checkfmt("(rn,-1pf18.3)", 643.125, " 64.312")
110 call checkfmt("(rn, 0pf18.3)", 643.125, " 643.125")
111
112 call checkfmt("(rp,-8pf18.3)", 643.125, " 0.000")
113 call checkfmt("(rp,-7pf18.3)", 643.125, " 0.000")
114 call checkfmt("(rp,-6pf18.3)", 643.125, " 0.001")
115 call checkfmt("(rp,-5pf18.3)", 643.125, " 0.006")
116 call checkfmt("(rp,-4pf18.3)", 643.125, " 0.064")
117 call checkfmt("(rp,-3pf18.3)", 643.125, " 0.643")
118 call checkfmt("(rp,-2pf18.3)", 643.125, " 6.431")
119 call checkfmt("(rp,-1pf18.3)", 643.125, " 64.312")
120 call checkfmt("(rp, 0pf18.3)", 643.125, " 643.125")
121
122 call checkfmt("(-8pf18.3)", -643.125, " -0.000")
123 call checkfmt("(-7pf18.3)", -643.125, " -0.000")
124 call checkfmt("(-6pf18.3)", -643.125, " -0.001")
125 call checkfmt("(-5pf18.3)", -643.125, " -0.006")
126 call checkfmt("(-4pf18.3)", -643.125, " -0.064")
127 call checkfmt("(-3pf18.3)", -643.125, " -0.643")
128 call checkfmt("(-2pf18.3)", -643.125, " -6.431")
129 call checkfmt("(-1pf18.3)", -643.125, " -64.312")
130 call checkfmt("( 0pf18.3)", -643.125, " -643.125")
131
132 call checkfmt("(ru,-8pf18.3)", -643.125, " -0.000")
133 call checkfmt("(ru,-7pf18.3)", -643.125, " -0.000")
134 call checkfmt("(ru,-6pf18.3)", -643.125, " -0.000")
135 call checkfmt("(ru,-5pf18.3)", -643.125, " -0.006")
136 call checkfmt("(ru,-4pf18.3)", -643.125, " -0.064")
137 call checkfmt("(ru,-3pf18.3)", -643.125, " -0.643")
138 call checkfmt("(ru,-2pf18.3)", -643.125, " -6.431")
139 call checkfmt("(ru,-1pf18.3)", -643.125, " -64.312")
140 call checkfmt("(ru, 0pf18.3)", -643.125, " -643.125")
141
142 call checkfmt("(rd,-8pf18.3)", -643.125, " -0.001")
143 call checkfmt("(rd,-7pf18.3)", -643.125, " -0.001")
144 call checkfmt("(rd,-6pf18.3)", -643.125, " -0.001")
145 call checkfmt("(rd,-5pf18.3)", -643.125, " -0.007")
146 call checkfmt("(rd,-4pf18.3)", -643.125, " -0.065")
147 call checkfmt("(rd,-3pf18.3)", -643.125, " -0.644")
148 call checkfmt("(rd,-2pf18.3)", -643.125, " -6.432")
149 call checkfmt("(rd,-1pf18.3)", -643.125, " -64.313")
150 call checkfmt("(rd, 0pf18.3)", -643.125, " -643.125")
151
152 call checkfmt("(rz,-8pf18.3)", -643.125, " -0.000")
153 call checkfmt("(rz,-7pf18.3)", -643.125, " -0.000")
154 call checkfmt("(rz,-6pf18.3)", -643.125, " -0.000")
155 call checkfmt("(rz,-5pf18.3)", -643.125, " -0.006")
156 call checkfmt("(rz,-4pf18.3)", -643.125, " -0.064")
157 call checkfmt("(rz,-3pf18.3)", -643.125, " -0.643")
158 call checkfmt("(rz,-2pf18.3)", -643.125, " -6.431")
159 call checkfmt("(rz,-1pf18.3)", -643.125, " -64.312")
160 call checkfmt("(rz, 0pf18.3)", -643.125, " -643.125")
161
162 call checkfmt("(rc,-8pf18.3)", -643.125, " -0.000")
163 call checkfmt("(rc,-7pf18.3)", -643.125, " -0.000")
164 call checkfmt("(rc,-6pf18.3)", -643.125, " -0.001")
165 call checkfmt("(rc,-5pf18.3)", -643.125, " -0.006")
166 call checkfmt("(rc,-4pf18.3)", -643.125, " -0.064")
167 call checkfmt("(rc,-3pf18.3)", -643.125, " -0.643")
168 call checkfmt("(rc,-2pf18.3)", -643.125, " -6.431")
169 call checkfmt("(rc,-1pf18.3)", -643.125, " -64.313")
170 call checkfmt("(rc, 0pf18.3)", -643.125, " -643.125")
171
172 call checkfmt("(rn,-8pf18.3)", -643.125, " -0.000")
173 call checkfmt("(rn,-7pf18.3)", -643.125, " -0.000")
174 call checkfmt("(rn,-6pf18.3)", -643.125, " -0.001")
175 call checkfmt("(rn,-5pf18.3)", -643.125, " -0.006")
176 call checkfmt("(rn,-4pf18.3)", -643.125, " -0.064")
177 call checkfmt("(rn,-3pf18.3)", -643.125, " -0.643")
178 call checkfmt("(rn,-2pf18.3)", -643.125, " -6.431")
179 call checkfmt("(rn,-1pf18.3)", -643.125, " -64.312")
180 call checkfmt("(rn, 0pf18.3)", -643.125, " -643.125")
181
182 call checkfmt("(rp,-8pf18.3)", -643.125, " -0.000")
183 call checkfmt("(rp,-7pf18.3)", -643.125, " -0.000")
184 call checkfmt("(rp,-6pf18.3)", -643.125, " -0.001")
185 call checkfmt("(rp,-5pf18.3)", -643.125, " -0.006")
186 call checkfmt("(rp,-4pf18.3)", -643.125, " -0.064")
187 call checkfmt("(rp,-3pf18.3)", -643.125, " -0.643")
188 call checkfmt("(rp,-2pf18.3)", -643.125, " -6.431")
189 call checkfmt("(rp,-1pf18.3)", -643.125, " -64.312")
190 call checkfmt("(rp, 0pf18.3)", -643.125, " -643.125")
191
192 ! print *, n_tst, n_cnt, n_skip
193 if (n_cnt /= 0) STOP 1
194 if (all(.not. l_skip)) print *, "All kinds rounded to nearest"
195
196 contains
197 subroutine checkfmt(fmt, x, cmp)
198 implicit none
199 integer :: i
200 character(len=*), intent(in) :: fmt
201 real, intent(in) :: x
202 character(len=*), intent(in) :: cmp
203 do i=1,size(real_kinds)
204 if (i == 1) then
205 write(s, fmt) real(x,kind=j(1))
206 else if (i == 2) then
207 write(s, fmt) real(x,kind=j(2))
208 else if (i == 3) then
209 write(s, fmt) real(x,kind=j(3))
210 else if (i == 4) then
211 write(s, fmt) real(x,kind=j(4))
212 end if
213 n_tst = n_tst + 1
214 if (s /= cmp) then
215 if (l_skip(i)) then
216 n_skip = n_skip + 1
217 else
218 print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
219 n_cnt = n_cnt + 1
220 end if
221 end if
222 end do
223
224 end subroutine
225 end program
226 ! { dg-output "All kinds rounded to nearest" { xfail { hppa*-*-hpux* } } }
Mirror of the offical gcc git repository hosted at gcc.gnu.org