Mercurial > hg > CbC > CbC_gcc

annotate gcc/testsuite/gfortran.dg/fmt_en.f90 @ 144:8f4e72ab4e11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix segmentation fault caused by nothing next cur_op to end
author Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Sun, 23 Dec 2018 21:23:56 +0900
parents 84e7813d76e9
children 1830386684a0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ! { dg-do run }
kono
parents:
diff changeset
2 ! PR60128 Invalid outputs with EN descriptors
kono
parents:
diff changeset
3 ! Test case provided by Walt Brainerd.
kono
parents:
diff changeset
4 program pr60128
kono
parents:
diff changeset
5 use ISO_FORTRAN_ENV
kono
parents:
diff changeset
6 implicit none
kono
parents:
diff changeset
7 integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]]
kono
parents:
diff changeset
8 logical :: l_skip(4) = .false.
kono
parents:
diff changeset
9 integer :: i
kono
parents:
diff changeset
10 integer :: n_tst = 0, n_cnt = 0, n_skip = 0
kono
parents:
diff changeset
11 character(len=20) :: s, s1
kono
parents:
diff changeset
12
kono
parents:
diff changeset
13 open (unit = 10, file = 'fmt_en.res')
kono
parents:
diff changeset
14 ! Check that the default rounding mode is to nearest and to even on tie.
kono
parents:
diff changeset
15 do i=1,size(real_kinds)
kono
parents:
diff changeset
16 if (i == 1) then
kono
parents:
diff changeset
17 write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(1)), &
kono
parents:
diff changeset
18 real(9.49999905,kind=j(1)), &
kono
parents:
diff changeset
19 real(9.5,kind=j(1)), real(8.5,kind=j(1))
kono
parents:
diff changeset
20 write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(1)), &
kono
parents:
diff changeset
21 real(98765.0,kind=j(1))
kono
parents:
diff changeset
22 else if (i == 2) then
kono
parents:
diff changeset
23 write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(2)), &
kono
parents:
diff changeset
24 real(9.49999905,kind=j(2)), &
kono
parents:
diff changeset
25 real(9.5,kind=j(2)), real(8.5,kind=j(2))
kono
parents:
diff changeset
26 write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(2)), &
kono
parents:
diff changeset
27 real(98765.0,kind=j(2))
kono
parents:
diff changeset
28 else if (i == 3) then
kono
parents:
diff changeset
29 write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(3)), &
kono
parents:
diff changeset
30 real(9.49999905,kind=j(3)), &
kono
parents:
diff changeset
31 real(9.5,kind=j(3)), real(8.5,kind=j(3))
kono
parents:
diff changeset
32 write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(3)), &
kono
parents:
diff changeset
33 real(98765.0,kind=j(3))
kono
parents:
diff changeset
34 else if (i == 4) then
kono
parents:
diff changeset
35 write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(4)), &
kono
parents:
diff changeset
36 real(9.49999905,kind=j(4)), &
kono
parents:
diff changeset
37 real(9.5,kind=j(4)), real(8.5,kind=j(4))
kono
parents:
diff changeset
38 write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(4)), &
kono
parents:
diff changeset
39 real(98765.0,kind=j(4))
kono
parents:
diff changeset
40 end if
kono
parents:
diff changeset
41 if (s /= '-9.5 9.5 10. 8.' .or. s1 /= ' 987.4E+03 98.76E+03') then
kono
parents:
diff changeset
42 l_skip(i) = .true.
kono
parents:
diff changeset
43 ! print "('Unsupported rounding for real(',i0,')')", j(i)
kono
parents:
diff changeset
44 end if
kono
parents:
diff changeset
45 end do
kono
parents:
diff changeset
46
kono
parents:
diff changeset
47
kono
parents:
diff changeset
48 ! Original test.
kono
parents:
diff changeset
49 call checkfmt("(en15.2)", -.44444, " -444.44E-03")
kono
parents:
diff changeset
50
kono
parents:
diff changeset
51 ! Test for the bug in comment 6.
kono
parents:
diff changeset
52 call checkfmt("(en15.0)", 1.0, " 1.E+00")
kono
parents:
diff changeset
53 call checkfmt("(en15.0)", 1.00000012, " 1.E+00")
kono
parents:
diff changeset
54 call checkfmt("(en15.0)", 0.99999994, " 1.E+00")
kono
parents:
diff changeset
55 call checkfmt("(en15.0)", 10.0, " 10.E+00")
kono
parents:
diff changeset
56 call checkfmt("(en15.0)", 10.0000010, " 10.E+00")
kono
parents:
diff changeset
57 call checkfmt("(en15.0)", 9.99999905, " 10.E+00")
kono
parents:
diff changeset
58 call checkfmt("(en15.0)", 100.0, " 100.E+00")
kono
parents:
diff changeset
59 call checkfmt("(en15.0)", 100.000008, " 100.E+00")
kono
parents:
diff changeset
60 call checkfmt("(en15.0)", 99.9999924, " 100.E+00")
kono
parents:
diff changeset
61 call checkfmt("(en15.0)", 1000.0, " 1.E+03")
kono
parents:
diff changeset
62 call checkfmt("(en15.0)", 1000.00006, " 1.E+03")
kono
parents:
diff changeset
63 call checkfmt("(en15.0)", 999.999939, " 1.E+03")
kono
parents:
diff changeset
64 call checkfmt("(en15.0)", 9.5, " 10.E+00")
kono
parents:
diff changeset
65 call checkfmt("(en15.0)", 9.50000095, " 10.E+00")
kono
parents:
diff changeset
66 call checkfmt("(en15.0)", 9.49999905, " 9.E+00")
kono
parents:
diff changeset
67 call checkfmt("(en15.0)", 99.5, " 100.E+00")
kono
parents:
diff changeset
68 call checkfmt("(en15.0)", 99.5000076, " 100.E+00")
kono
parents:
diff changeset
69 call checkfmt("(en15.0)", 99.4999924, " 99.E+00")
kono
parents:
diff changeset
70 call checkfmt("(en15.0)", 999.5, " 1.E+03")
kono
parents:
diff changeset
71 call checkfmt("(en15.0)", 999.500061, " 1.E+03")
kono
parents:
diff changeset
72 call checkfmt("(en15.0)", 999.499939, " 999.E+00")
kono
parents:
diff changeset
73 call checkfmt("(en15.0)", 9500.0, " 10.E+03")
kono
parents:
diff changeset
74 call checkfmt("(en15.0)", 9500.00098, " 10.E+03")
kono
parents:
diff changeset
75 call checkfmt("(en15.0)", 9499.99902, " 9.E+03")
kono
parents:
diff changeset
76 call checkfmt("(en15.1)", 9950.0, " 10.0E+03")
kono
parents:
diff changeset
77 call checkfmt("(en15.2)", 9995.0, " 10.00E+03")
kono
parents:
diff changeset
78 call checkfmt("(en15.3)", 9999.5, " 10.000E+03")
kono
parents:
diff changeset
79 call checkfmt("(en15.1)", 9.5, " 9.5E+00")
kono
parents:
diff changeset
80 call checkfmt("(en15.1)", 9.50000095, " 9.5E+00")
kono
parents:
diff changeset
81 call checkfmt("(en15.1)", 9.49999905, " 9.5E+00")
kono
parents:
diff changeset
82 call checkfmt("(en15.1)", 0.099951, " 100.0E-03")
kono
parents:
diff changeset
83 call checkfmt("(en15.1)", 0.009951, " 10.0E-03")
kono
parents:
diff changeset
84 call checkfmt("(en15.1)", 0.000999951," 1.0E-03")
kono
parents:
diff changeset
85
kono
parents:
diff changeset
86 call checkfmt("(en15.0)", -1.0, " -1.E+00")
kono
parents:
diff changeset
87 call checkfmt("(en15.0)", -1.00000012, " -1.E+00")
kono
parents:
diff changeset
88 call checkfmt("(en15.0)", -0.99999994, " -1.E+00")
kono
parents:
diff changeset
89 call checkfmt("(en15.0)", -10.0, " -10.E+00")
kono
parents:
diff changeset
90 call checkfmt("(en15.0)", -10.0000010, " -10.E+00")
kono
parents:
diff changeset
91 call checkfmt("(en15.0)", -9.99999905, " -10.E+00")
kono
parents:
diff changeset
92 call checkfmt("(en15.0)", -100.0, " -100.E+00")
kono
parents:
diff changeset
93 call checkfmt("(en15.0)", -100.000008, " -100.E+00")
kono
parents:
diff changeset
94 call checkfmt("(en15.0)", -99.9999924, " -100.E+00")
kono
parents:
diff changeset
95 call checkfmt("(en15.0)", -1000.0, " -1.E+03")
kono
parents:
diff changeset
96 call checkfmt("(en15.0)", -1000.00006, " -1.E+03")
kono
parents:
diff changeset
97 call checkfmt("(en15.0)", -999.999939, " -1.E+03")
kono
parents:
diff changeset
98 call checkfmt("(en15.0)", -9.5, " -10.E+00")
kono
parents:
diff changeset
99 call checkfmt("(en15.0)", -9.50000095, " -10.E+00")
kono
parents:
diff changeset
100 call checkfmt("(en15.0)", -9.49999905, " -9.E+00")
kono
parents:
diff changeset
101 call checkfmt("(en15.0)", -99.5, " -100.E+00")
kono
parents:
diff changeset
102 call checkfmt("(en15.0)", -99.5000076, " -100.E+00")
kono
parents:
diff changeset
103 call checkfmt("(en15.0)", -99.4999924, " -99.E+00")
kono
parents:
diff changeset
104 call checkfmt("(en15.0)", -999.5, " -1.E+03")
kono
parents:
diff changeset
105 call checkfmt("(en15.0)", -999.500061, " -1.E+03")
kono
parents:
diff changeset
106 call checkfmt("(en15.0)", -999.499939, " -999.E+00")
kono
parents:
diff changeset
107 call checkfmt("(en15.0)", -9500.0, " -10.E+03")
kono
parents:
diff changeset
108 call checkfmt("(en15.0)", -9500.00098, " -10.E+03")
kono
parents:
diff changeset
109 call checkfmt("(en15.0)", -9499.99902, " -9.E+03")
kono
parents:
diff changeset
110 call checkfmt("(en15.1)", -9950.0, " -10.0E+03")
kono
parents:
diff changeset
111 call checkfmt("(en15.2)", -9995.0, " -10.00E+03")
kono
parents:
diff changeset
112 call checkfmt("(en15.3)", -9999.5, " -10.000E+03")
kono
parents:
diff changeset
113 call checkfmt("(en15.1)", -9.5, " -9.5E+00")
kono
parents:
diff changeset
114 call checkfmt("(en15.1)", -9.50000095, " -9.5E+00")
kono
parents:
diff changeset
115 call checkfmt("(en15.1)", -9.49999905, " -9.5E+00")
kono
parents:
diff changeset
116 call checkfmt("(en15.1)", -0.099951, " -100.0E-03")
kono
parents:
diff changeset
117 call checkfmt("(en15.1)", -0.009951, " -10.0E-03")
kono
parents:
diff changeset
118 call checkfmt("(en15.1)", -0.000999951," -1.0E-03")
kono
parents:
diff changeset
119
kono
parents:
diff changeset
120 call checkfmt("(en15.1)", 987350., " 987.4E+03")
kono
parents:
diff changeset
121 call checkfmt("(en15.2)", 98735., " 98.74E+03")
kono
parents:
diff changeset
122 call checkfmt("(en15.3)", 9873.5, " 9.874E+03")
kono
parents:
diff changeset
123 call checkfmt("(en15.1)", 987650., " 987.6E+03")
kono
parents:
diff changeset
124 call checkfmt("(en15.2)", 98765., " 98.76E+03")
kono
parents:
diff changeset
125 call checkfmt("(en15.3)", 9876.5, " 9.876E+03")
kono
parents:
diff changeset
126 call checkfmt("(en15.1)", 3.125E-02, " 31.2E-03")
kono
parents:
diff changeset
127 call checkfmt("(en15.1)", 9.375E-02, " 93.8E-03")
kono
parents:
diff changeset
128 call checkfmt("(en15.2)", 1.5625E-02, " 15.62E-03")
kono
parents:
diff changeset
129 call checkfmt("(en15.2)", 4.6875E-02, " 46.88E-03")
kono
parents:
diff changeset
130 call checkfmt("(en15.3)", 7.8125E-03, " 7.812E-03")
kono
parents:
diff changeset
131 call checkfmt("(en15.3)", 2.34375E-02, " 23.438E-03")
kono
parents:
diff changeset
132 call checkfmt("(en15.3)", 9.765625E-04," 976.562E-06")
kono
parents:
diff changeset
133 call checkfmt("(en15.6)", 2.9296875E-03," 2.929688E-03")
kono
parents:
diff changeset
134
kono
parents:
diff changeset
135 call checkfmt("(en15.1)", -987350., " -987.4E+03")
kono
parents:
diff changeset
136 call checkfmt("(en15.2)", -98735., " -98.74E+03")
kono
parents:
diff changeset
137 call checkfmt("(en15.3)", -9873.5, " -9.874E+03")
kono
parents:
diff changeset
138 call checkfmt("(en15.1)", -987650., " -987.6E+03")
kono
parents:
diff changeset
139 call checkfmt("(en15.2)", -98765., " -98.76E+03")
kono
parents:
diff changeset
140 call checkfmt("(en15.3)", -9876.5, " -9.876E+03")
kono
parents:
diff changeset
141 call checkfmt("(en15.1)", -3.125E-02, " -31.2E-03")
kono
parents:
diff changeset
142 call checkfmt("(en15.1)", -9.375E-02, " -93.8E-03")
kono
parents:
diff changeset
143 call checkfmt("(en15.2)", -1.5625E-02, " -15.62E-03")
kono
parents:
diff changeset
144 call checkfmt("(en15.2)", -4.6875E-02, " -46.88E-03")
kono
parents:
diff changeset
145 call checkfmt("(en15.3)", -7.8125E-03, " -7.812E-03")
kono
parents:
diff changeset
146 call checkfmt("(en15.3)", -2.34375E-02, " -23.438E-03")
kono
parents:
diff changeset
147 call checkfmt("(en15.3)", -9.765625E-04," -976.562E-06")
kono
parents:
diff changeset
148 call checkfmt("(en15.6)", -2.9296875E-03," -2.929688E-03")
kono
parents:
diff changeset
149
kono
parents:
diff changeset
150 ! print *, n_tst, n_cnt, n_skip
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
151 if (n_cnt /= 0) STOP 1
111
kono
parents:
diff changeset
152 if (all(.not. l_skip)) write (10, *) "All kinds rounded to nearest"
kono
parents:
diff changeset
153 close (10)
kono
parents:
diff changeset
154
kono
parents:
diff changeset
155 contains
kono
parents:
diff changeset
156 subroutine checkfmt(fmt, x, cmp)
kono
parents:
diff changeset
157 implicit none
kono
parents:
diff changeset
158 integer :: i
kono
parents:
diff changeset
159 character(len=*), intent(in) :: fmt
kono
parents:
diff changeset
160 real, intent(in) :: x
kono
parents:
diff changeset
161 character(len=*), intent(in) :: cmp
kono
parents:
diff changeset
162 do i=1,size(real_kinds)
kono
parents:
diff changeset
163 if (i == 1) then
kono
parents:
diff changeset
164 write(s, fmt) real(x,kind=j(1))
kono
parents:
diff changeset
165 else if (i == 2) then
kono
parents:
diff changeset
166 write(s, fmt) real(x,kind=j(2))
kono
parents:
diff changeset
167 else if (i == 3) then
kono
parents:
diff changeset
168 write(s, fmt) real(x,kind=j(3))
kono
parents:
diff changeset
169 else if (i == 4) then
kono
parents:
diff changeset
170 write(s, fmt) real(x,kind=j(4))
kono
parents:
diff changeset
171 end if
kono
parents:
diff changeset
172 n_tst = n_tst + 1
kono
parents:
diff changeset
173 if (s /= cmp) then
kono
parents:
diff changeset
174 if (l_skip(i)) then
kono
parents:
diff changeset
175 n_skip = n_skip + 1
kono
parents:
diff changeset
176 else
kono
parents:
diff changeset
177 print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
kono
parents:
diff changeset
178 n_cnt = n_cnt + 1
kono
parents:
diff changeset
179 end if
kono
parents:
diff changeset
180 end if
kono
parents:
diff changeset
181 end do
kono
parents:
diff changeset
182
kono
parents:
diff changeset
183 end subroutine
kono
parents:
diff changeset
184 end program
kono
parents:
diff changeset
185 ! { dg-final { scan-file fmt_en.res "All kinds rounded to nearest" { xfail hppa*-*-hpux* } } }