[gcc(refs/users/guojiufu/heads/personal-branch)] PR 93592 - Invalid UP/DOWN rounding with EN descriptor.
Jiu Fu Guo
guojiufu@gcc.gnu.org
Mon Aug 10 07:19:13 GMT 2020
https://gcc.gnu.org/g:05e0971bcf94a481cbfa2731484f024a67dbd4a5
commit 05e0971bcf94a481cbfa2731484f024a67dbd4a5
Author: Dominique d'Humieres <dhumieres.dominique@free.fr>
Date: Fri Jul 24 20:07:12 2020 +0200
PR 93592 - Invalid UP/DOWN rounding with EN descriptor.
The fix is obvious (I have added a comment). The tests are probably
an overkill, but it does not hurt.
libgfortran/ChangeLog:
PR fortran/93592
* io/write_float.def (build_float_string): Do not reset
nbefore for FMT_F and FMT_EN.
gcc/testsuite/ChangeLog:
PR fortran/93592
* gfortran.dg/fmt_en.f90: Adjust test.
* gfortran.dg/fmt_en_rd.f90: New test.
* gfortran.dg/fmt_en_rn.f90: New test.
* gfortran.dg/fmt_en_ru.f90: New test.
* gfortran.dg/fmt_en_rz.f90: New test.
Diff:
---
gcc/testsuite/gfortran.dg/fmt_en.f90 | 6 +-
gcc/testsuite/gfortran.dg/fmt_en_rd.f90 | 185 ++++++++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/fmt_en_rn.f90 | 185 ++++++++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/fmt_en_ru.f90 | 185 ++++++++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/fmt_en_rz.f90 | 185 ++++++++++++++++++++++++++++++++
libgfortran/io/write_float.def | 3 +-
6 files changed, 744 insertions(+), 5 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/fmt_en.f90 b/gcc/testsuite/gfortran.dg/fmt_en.f90
index 89011b32368..d7e51b3fa21 100644
--- a/gcc/testsuite/gfortran.dg/fmt_en.f90
+++ b/gcc/testsuite/gfortran.dg/fmt_en.f90
@@ -10,7 +10,6 @@ use ISO_FORTRAN_ENV
integer :: n_tst = 0, n_cnt = 0, n_skip = 0
character(len=20) :: s, s1
- open (unit = 10, file = 'fmt_en.res')
! Check that the default rounding mode is to nearest and to even on tie.
do i=1,size(real_kinds)
if (i == 1) then
@@ -149,8 +148,7 @@ use ISO_FORTRAN_ENV
! print *, n_tst, n_cnt, n_skip
if (n_cnt /= 0) STOP 1
- if (all(.not. l_skip)) write (10, *) "All kinds rounded to nearest"
- close (10)
+ if (all(.not. l_skip)) print *, "All kinds rounded to nearest"
contains
subroutine checkfmt(fmt, x, cmp)
@@ -182,4 +180,4 @@ contains
end subroutine
end program
-! { dg-final { scan-file fmt_en.res "All kinds rounded to nearest" { xfail hppa*-*-hpux* } } }
+! { dg-output "All kinds rounded to nearest" { xfail { i?86-*-solaris2.9* hppa*-*-hpux* } } }
diff --git a/gcc/testsuite/gfortran.dg/fmt_en_rd.f90 b/gcc/testsuite/gfortran.dg/fmt_en_rd.f90
new file mode 100644
index 00000000000..ea914e0901c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_en_rd.f90
@@ -0,0 +1,185 @@
+! { dg-do run }
+! PR60128 Invalid outputs with EN descriptors
+! Test case provided by Walt Brainerd.
+program pr60128
+use ISO_FORTRAN_ENV
+ implicit none
+ integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]]
+ logical :: l_skip(4) = .false.
+ integer :: i
+ integer :: n_tst = 0, n_cnt = 0, n_skip = 0
+ character(len=20,kind=4) :: s, s1
+
+! Check that the default rounding mode is to nearest and to even on tie.
+ do i=1,size(real_kinds)
+ if (i == 1) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(1)), &
+ real(9.49999905,kind=j(1)), &
+ real(9.5,kind=j(1)), real(8.5,kind=j(1))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(1)), &
+ real(98765.0,kind=j(1))
+ else if (i == 2) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(2)), &
+ real(9.49999905,kind=j(2)), &
+ real(9.5,kind=j(2)), real(8.5,kind=j(2))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(2)), &
+ real(98765.0,kind=j(2))
+ else if (i == 3) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(3)), &
+ real(9.49999905,kind=j(3)), &
+ real(9.5,kind=j(3)), real(8.5,kind=j(3))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(3)), &
+ real(98765.0,kind=j(3))
+ else if (i == 4) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(4)), &
+ real(9.49999905,kind=j(4)), &
+ real(9.5,kind=j(4)), real(8.5,kind=j(4))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(4)), &
+ real(98765.0,kind=j(4))
+ end if
+ if (s /= 4_'-9.5 9.5 10. 8.' .or. s1 /= 4_' 987.4E+03 98.76E+03') then
+ l_skip(i) = .true.
+ print "('Unsupported rounding for real(',i0,')')", j(i)
+ end if
+ end do
+
+
+! Original test.
+ call checkfmt("(en15.2)", -.44444, 4_" -444.44E-03")
+
+! Test for the bug in comment 6.
+ call checkfmt("(rd,en15.0)", 1.0, 4_" 1.E+00")
+ call checkfmt("(rd,en15.0)", 1.00000012, 4_" 1.E+00")
+ call checkfmt("(rd,en15.0)", 0.99999994, 4_" 999.E-03")
+ call checkfmt("(rd,en15.0)", 10.0, 4_" 10.E+00")
+ call checkfmt("(rd,en15.0)", 10.0000010, 4_" 10.E+00")
+ call checkfmt("(rd,en15.0)", 9.99999905, 4_" 9.E+00")
+ call checkfmt("(ru,en15.0)", 100.0, 4_" 100.E+00")
+ call checkfmt("(rd,en15.0)", 100.000008, 4_" 100.E+00")
+ call checkfmt("(rd,en15.0)", 99.9999924, 4_" 99.E+00")
+ call checkfmt("(rd,en15.0)", 1000.0, 4_" 1.E+03")
+ call checkfmt("(rd,en15.0)", 1000.00006, 4_" 1.E+03")
+ call checkfmt("(rd,en15.0)", 999.999939, 4_" 999.E+00")
+ call checkfmt("(rd,en15.0)", 9.5, 4_" 9.E+00")
+ call checkfmt("(rd,en15.0)", 9.50000095, 4_" 9.E+00")
+ call checkfmt("(rd,en15.0)", 9.49999905, 4_" 9.E+00")
+ call checkfmt("(rd,en15.0)", 99.5, 4_" 99.E+00")
+ call checkfmt("(rd,en15.0)", 99.5000076, 4_" 99.E+00")
+ call checkfmt("(rd,en15.0)", 99.4999924, 4_" 99.E+00")
+ call checkfmt("(rd,en15.0)", 999.5, 4_" 999.E+00")
+ call checkfmt("(rd,en15.0)", 999.500061, 4_" 999.E+00")
+ call checkfmt("(rd,en15.0)", 999.499939, 4_" 999.E+00")
+ call checkfmt("(rd,en15.0)", 9500.0, 4_" 9.E+03")
+ call checkfmt("(rd,en15.0)", 9500.00098, 4_" 9.E+03")
+ call checkfmt("(rd,en15.0)", 9499.99902, 4_" 9.E+03")
+ call checkfmt("(rd,en15.1)", 9950.0, 4_" 9.9E+03")
+ call checkfmt("(rd,en15.2)", 9995.0, 4_" 9.99E+03")
+ call checkfmt("(rd,en15.3)", 9999.5, 4_" 9.999E+03")
+ call checkfmt("(rd,en15.1)", 9.5, 4_" 9.5E+00")
+ call checkfmt("(rd,en15.1)", 9.50000095, 4_" 9.5E+00")
+ call checkfmt("(rd,en15.1)", 9.49999905, 4_" 9.4E+00")
+ call checkfmt("(rd,en15.1)", 0.099951, 4_" 99.9E-03")
+ call checkfmt("(rd,en15.1)", 0.009951, 4_" 9.9E-03")
+ call checkfmt("(rd,en15.1)", 0.000999951,4_" 999.9E-06")
+
+ call checkfmt("(rd,en15.0)", -1.0, 4_" -1.E+00")
+ call checkfmt("(rd,en15.0)", -1.00000012, 4_" -2.E+00")
+ call checkfmt("(rd,en15.0)", -0.99999994, 4_" -1.E+00")
+ call checkfmt("(rd,en15.0)", -10.0, 4_" -10.E+00")
+ call checkfmt("(rd,en15.0)", -10.0000010, 4_" -11.E+00")
+ call checkfmt("(rd,en15.0)", -9.99999905, 4_" -10.E+00")
+ call checkfmt("(rd,en15.0)", -100.0, 4_" -100.E+00")
+ call checkfmt("(rd,en15.0)", -100.000008, 4_" -101.E+00")
+ call checkfmt("(rd,en15.0)", -99.9999924, 4_" -100.E+00")
+ call checkfmt("(rd,en15.0)", -1000.0, 4_" -1.E+03")
+ call checkfmt("(rd,en15.0)", -1000.00006, 4_" -2.E+03")
+ call checkfmt("(rd,en15.0)", -999.999939, 4_" -1.E+03")
+ call checkfmt("(rd,en15.0)", -9.5, 4_" -10.E+00")
+ call checkfmt("(rd,en15.0)", -9.50000095, 4_" -10.E+00")
+ call checkfmt("(rd,en15.0)", -9.49999905, 4_" -10.E+00")
+ call checkfmt("(rd,en15.0)", -99.5, 4_" -100.E+00")
+ call checkfmt("(rd,en15.0)", -99.5000076, 4_" -100.E+00")
+ call checkfmt("(rd,en15.0)", -99.4999924, 4_" -100.E+00")
+ call checkfmt("(rd,en15.0)", -999.5, 4_" -1.E+03")
+ call checkfmt("(rd,en15.0)", -999.500061, 4_" -1.E+03")
+ call checkfmt("(rd,en15.0)", -999.499939, 4_" -1.E+03")
+ call checkfmt("(rd,en15.0)", -9500.0, 4_" -10.E+03")
+ call checkfmt("(rd,en15.0)", -9500.00098, 4_" -10.E+03")
+ call checkfmt("(rd,en15.0)", -9499.99902, 4_" -10.E+03")
+ call checkfmt("(rd,en15.1)", -9950.0, 4_" -10.0E+03")
+ call checkfmt("(rd,en15.2)", -9995.0, 4_" -10.00E+03")
+ call checkfmt("(rd,en15.3)", -9999.5, 4_" -10.000E+03")
+ call checkfmt("(rd,en15.1)", -9.5, 4_" -9.5E+00")
+ call checkfmt("(rd,en15.1)", -9.50000095, 4_" -9.6E+00")
+ call checkfmt("(rd,en15.1)", -9.49999905, 4_" -9.5E+00")
+ call checkfmt("(rd,en15.1)", -0.099951, 4_" -100.0E-03")
+ call checkfmt("(rd,en15.1)", -0.009951, 4_" -10.0E-03")
+ call checkfmt("(rd,en15.1)", -0.000999951,4_" -1.0E-03")
+
+ call checkfmt("(rd,en15.1)", 987350., 4_" 987.3E+03")
+ call checkfmt("(rd,en15.2)", 98735., 4_" 98.73E+03")
+ call checkfmt("(rd,en15.3)", 9873.5, 4_" 9.873E+03")
+ call checkfmt("(rd,en15.1)", 987650., 4_" 987.6E+03")
+ call checkfmt("(rd,en15.2)", 98765., 4_" 98.76E+03")
+ call checkfmt("(rd,en15.3)", 9876.5, 4_" 9.876E+03")
+ call checkfmt("(rd,en15.1)", 3.125E-02, 4_" 31.2E-03")
+ call checkfmt("(rd,en15.1)", 9.375E-02, 4_" 93.7E-03")
+ call checkfmt("(rd,en15.2)", 1.5625E-02, 4_" 15.62E-03")
+ call checkfmt("(rd,en15.2)", 4.6875E-02, 4_" 46.87E-03")
+ call checkfmt("(rd,en15.3)", 7.8125E-03, 4_" 7.812E-03")
+ call checkfmt("(rd,en15.3)", 2.34375E-02, 4_" 23.437E-03")
+ call checkfmt("(rd,en15.3)", 9.765625E-04,4_" 976.562E-06")
+ call checkfmt("(rd,en15.6)", 2.9296875E-03,4_" 2.929687E-03")
+
+ call checkfmt("(rd,en15.1)", -987350., 4_" -987.4E+03")
+ call checkfmt("(rd,en15.2)", -98735., 4_" -98.74E+03")
+ call checkfmt("(rd,en15.3)", -9873.5, 4_" -9.874E+03")
+ call checkfmt("(rd,en15.1)", -987650., 4_" -987.7E+03")
+ call checkfmt("(rd,en15.2)", -98765., 4_" -98.77E+03")
+ call checkfmt("(rd,en15.3)", -9876.5, 4_" -9.877E+03")
+ call checkfmt("(rd,en15.1)", -3.125E-02, 4_" -31.3E-03")
+ call checkfmt("(rd,en15.1)", -9.375E-02, 4_" -93.8E-03")
+ call checkfmt("(rd,en15.2)", -1.5625E-02, 4_" -15.63E-03")
+ call checkfmt("(rd,en15.2)", -4.6875E-02, 4_" -46.88E-03")
+ call checkfmt("(rd,en15.3)", -7.8125E-03, 4_" -7.813E-03")
+ call checkfmt("(rd,en15.3)", -2.34375E-02, 4_" -23.438E-03")
+ call checkfmt("(rd,en15.3)", -9.765625E-04,4_" -976.563E-06")
+ call checkfmt("(rd,en15.6)", -2.9296875E-03,4_" -2.929688E-03")
+
+ print *, n_tst, n_cnt, n_skip
+ if (n_cnt /= 0) stop n_cnt
+ if (all(.not. l_skip)) print *, "All kinds rounded down"
+
+contains
+ subroutine checkfmt(fmt, x, cmp)
+ implicit none
+ integer :: i
+ character(len=*), intent(in) :: fmt
+ real, intent(in) :: x
+ character(len=*, kind=4), intent(in) :: cmp
+ do i=1,size(real_kinds)
+ if (l_skip(i)) cycle
+ if (i == 1) then
+ write(s, fmt) real(x,kind=j(1))
+ else if (i == 2) then
+ write(s, fmt) real(x,kind=j(2))
+ else if (i == 3) then
+ write(s, fmt) real(x,kind=j(3))
+ else if (i == 4) then
+ write(s, fmt) real(x,kind=j(4))
+ end if
+ n_tst = n_tst + 1
+ if (s /= cmp) then
+ if (l_skip(i)) then
+ n_skip = n_skip + 1
+ else
+ print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
+ n_cnt = n_cnt + 1
+ end if
+ end if
+ end do
+
+ end subroutine
+end program
+! { dg-output "All kinds rounded down" { xfail { i?86-*-solaris2.9* hppa*-*-hpux* } } }
+! { dg-final { cleanup-saved-temps } }
diff --git a/gcc/testsuite/gfortran.dg/fmt_en_rn.f90 b/gcc/testsuite/gfortran.dg/fmt_en_rn.f90
new file mode 100644
index 00000000000..b0ada5c672d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_en_rn.f90
@@ -0,0 +1,185 @@
+! { dg-do run }
+! PR60128 Invalid outputs with EN descriptors
+! Test case provided by Walt Brainerd.
+program pr60128
+use ISO_FORTRAN_ENV
+ implicit none
+ integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]]
+ logical :: l_skip(4) = .false.
+ integer :: i
+ integer :: n_tst = 0, n_cnt = 0, n_skip = 0
+ character(len=20,kind=4) :: s, s1
+
+! Check that the default rounding mode is to nearest and to even on tie.
+ do i=1,size(real_kinds)
+ if (i == 1) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(1)), &
+ real(9.49999905,kind=j(1)), &
+ real(9.5,kind=j(1)), real(8.5,kind=j(1))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(1)), &
+ real(98765.0,kind=j(1))
+ else if (i == 2) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(2)), &
+ real(9.49999905,kind=j(2)), &
+ real(9.5,kind=j(2)), real(8.5,kind=j(2))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(2)), &
+ real(98765.0,kind=j(2))
+ else if (i == 3) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(3)), &
+ real(9.49999905,kind=j(3)), &
+ real(9.5,kind=j(3)), real(8.5,kind=j(3))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(3)), &
+ real(98765.0,kind=j(3))
+ else if (i == 4) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(4)), &
+ real(9.49999905,kind=j(4)), &
+ real(9.5,kind=j(4)), real(8.5,kind=j(4))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(4)), &
+ real(98765.0,kind=j(4))
+ end if
+ if (s /= 4_'-9.5 9.5 10. 8.' .or. s1 /= 4_' 987.4E+03 98.76E+03') then
+ l_skip(i) = .true.
+ print "('Unsupported rounding for real(',i0,')')", j(i)
+ end if
+ end do
+
+
+! Original test.
+ call checkfmt("(en15.2)", -.44444, 4_" -444.44E-03")
+
+! Test for the bug in comment 6.
+ call checkfmt("(rn,en15.0)", 1.0, 4_" 1.E+00")
+ call checkfmt("(rn,en15.0)", 1.00000012, 4_" 1.E+00")
+ call checkfmt("(rn,en15.0)", 0.99999994, 4_" 1.E+00")
+ call checkfmt("(rn,en15.0)", 10.0, 4_" 10.E+00")
+ call checkfmt("(rn,en15.0)", 10.0000010, 4_" 10.E+00")
+ call checkfmt("(rn,en15.0)", 9.99999905, 4_" 10.E+00")
+ call checkfmt("(rn,en15.0)", 100.0, 4_" 100.E+00")
+ call checkfmt("(rn,en15.0)", 100.000008, 4_" 100.E+00")
+ call checkfmt("(rn,en15.0)", 99.9999924, 4_" 100.E+00")
+ call checkfmt("(rn,en15.0)", 1000.0, 4_" 1.E+03")
+ call checkfmt("(rn,en15.0)", 1000.00006, 4_" 1.E+03")
+ call checkfmt("(rn,en15.0)", 999.999939, 4_" 1.E+03")
+ call checkfmt("(rn,en15.0)", 9.5, 4_" 10.E+00")
+ call checkfmt("(rn,en15.0)", 9.50000095, 4_" 10.E+00")
+ call checkfmt("(rn,en15.0)", 9.49999905, 4_" 9.E+00")
+ call checkfmt("(rn,en15.0)", 99.5, 4_" 100.E+00")
+ call checkfmt("(rn,en15.0)", 99.5000076, 4_" 100.E+00")
+ call checkfmt("(rn,en15.0)", 99.4999924, 4_" 99.E+00")
+ call checkfmt("(rn,en15.0)", 999.5, 4_" 1.E+03")
+ call checkfmt("(rn,en15.0)", 999.500061, 4_" 1.E+03")
+ call checkfmt("(rn,en15.0)", 999.499939, 4_" 999.E+00")
+ call checkfmt("(rn,en15.0)", 9500.0, 4_" 10.E+03")
+ call checkfmt("(rn,en15.0)", 9500.00098, 4_" 10.E+03")
+ call checkfmt("(rn,en15.0)", 9499.99902, 4_" 9.E+03")
+ call checkfmt("(rn,en15.1)", 9950.0, 4_" 10.0E+03")
+ call checkfmt("(rn,en15.2)", 9995.0, 4_" 10.00E+03")
+ call checkfmt("(rn,en15.3)", 9999.5, 4_" 10.000E+03")
+ call checkfmt("(rn,en15.1)", 9.5, 4_" 9.5E+00")
+ call checkfmt("(rn,en15.1)", 9.50000095, 4_" 9.5E+00")
+ call checkfmt("(rn,en15.1)", 9.49999905, 4_" 9.5E+00")
+ call checkfmt("(rn,en15.1)", 0.099951, 4_" 100.0E-03")
+ call checkfmt("(rn,en15.1)", 0.009951, 4_" 10.0E-03")
+ call checkfmt("(rn,en15.1)", 0.000999951,4_" 1.0E-03")
+
+ call checkfmt("(rn,en15.0)", -1.0, 4_" -1.E+00")
+ call checkfmt("(rn,en15.0)", -1.00000012, 4_" -1.E+00")
+ call checkfmt("(rn,en15.0)", -0.99999994, 4_" -1.E+00")
+ call checkfmt("(rn,en15.0)", -10.0, 4_" -10.E+00")
+ call checkfmt("(rn,en15.0)", -10.0000010, 4_" -10.E+00")
+ call checkfmt("(rn,en15.0)", -9.99999905, 4_" -10.E+00")
+ call checkfmt("(rn,en15.0)", -100.0, 4_" -100.E+00")
+ call checkfmt("(rn,en15.0)", -100.000008, 4_" -100.E+00")
+ call checkfmt("(rn,en15.0)", -99.9999924, 4_" -100.E+00")
+ call checkfmt("(rn,en15.0)", -1000.0, 4_" -1.E+03")
+ call checkfmt("(rn,en15.0)", -1000.00006, 4_" -1.E+03")
+ call checkfmt("(rn,en15.0)", -999.999939, 4_" -1.E+03")
+ call checkfmt("(rn,en15.0)", -9.5, 4_" -10.E+00")
+ call checkfmt("(rn,en15.0)", -9.50000095, 4_" -10.E+00")
+ call checkfmt("(rn,en15.0)", -9.49999905, 4_" -9.E+00")
+ call checkfmt("(rn,en15.0)", -99.5, 4_" -100.E+00")
+ call checkfmt("(rn,en15.0)", -99.5000076, 4_" -100.E+00")
+ call checkfmt("(rn,en15.0)", -99.4999924, 4_" -99.E+00")
+ call checkfmt("(rn,en15.0)", -999.5, 4_" -1.E+03")
+ call checkfmt("(rn,en15.0)", -999.500061, 4_" -1.E+03")
+ call checkfmt("(rn,en15.0)", -999.499939, 4_" -999.E+00")
+ call checkfmt("(rn,en15.0)", -9500.0, 4_" -10.E+03")
+ call checkfmt("(rn,en15.0)", -9500.00098, 4_" -10.E+03")
+ call checkfmt("(rn,en15.0)", -9499.99902, 4_" -9.E+03")
+ call checkfmt("(rn,en15.1)", -9950.0, 4_" -10.0E+03")
+ call checkfmt("(rn,en15.2)", -9995.0, 4_" -10.00E+03")
+ call checkfmt("(rn,en15.3)", -9999.5, 4_" -10.000E+03")
+ call checkfmt("(rn,en15.1)", -9.5, 4_" -9.5E+00")
+ call checkfmt("(rn,en15.1)", -9.50000095, 4_" -9.5E+00")
+ call checkfmt("(rn,en15.1)", -9.49999905, 4_" -9.5E+00")
+ call checkfmt("(rn,en15.1)", -0.099951, 4_" -100.0E-03")
+ call checkfmt("(rn,en15.1)", -0.009951, 4_" -10.0E-03")
+ call checkfmt("(rn,en15.1)", -0.000999951,4_" -1.0E-03")
+
+ call checkfmt("(rn,en15.1)", 987350., 4_" 987.4E+03")
+ call checkfmt("(rn,en15.2)", 98735., 4_" 98.74E+03")
+ call checkfmt("(rn,en15.3)", 9873.5, 4_" 9.874E+03")
+ call checkfmt("(rn,en15.1)", 987650., 4_" 987.6E+03")
+ call checkfmt("(rn,en15.2)", 98765., 4_" 98.76E+03")
+ call checkfmt("(rn,en15.3)", 9876.5, 4_" 9.876E+03")
+ call checkfmt("(rn,en15.1)", 3.125E-02, 4_" 31.2E-03")
+ call checkfmt("(rn,en15.1)", 9.375E-02, 4_" 93.8E-03")
+ call checkfmt("(rn,en15.2)", 1.5625E-02, 4_" 15.62E-03")
+ call checkfmt("(rn,en15.2)", 4.6875E-02, 4_" 46.88E-03")
+ call checkfmt("(rn,en15.3)", 7.8125E-03, 4_" 7.812E-03")
+ call checkfmt("(rn,en15.3)", 2.34375E-02, 4_" 23.438E-03")
+ call checkfmt("(rn,en15.3)", 9.765625E-04,4_" 976.562E-06")
+ call checkfmt("(rn,en15.6)", 2.9296875E-03,4_" 2.929688E-03")
+
+ call checkfmt("(rn,en15.1)", -987350., 4_" -987.4E+03")
+ call checkfmt("(rn,en15.2)", -98735., 4_" -98.74E+03")
+ call checkfmt("(rn,en15.3)", -9873.5, 4_" -9.874E+03")
+ call checkfmt("(rn,en15.1)", -987650., 4_" -987.6E+03")
+ call checkfmt("(rn,en15.2)", -98765., 4_" -98.76E+03")
+ call checkfmt("(rn,en15.3)", -9876.5, 4_" -9.876E+03")
+ call checkfmt("(rn,en15.1)", -3.125E-02, 4_" -31.2E-03")
+ call checkfmt("(rn,en15.1)", -9.375E-02, 4_" -93.8E-03")
+ call checkfmt("(rn,en15.2)", -1.5625E-02, 4_" -15.62E-03")
+ call checkfmt("(rn,en15.2)", -4.6875E-02, 4_" -46.88E-03")
+ call checkfmt("(rn,en15.3)", -7.8125E-03, 4_" -7.812E-03")
+ call checkfmt("(rn,en15.3)", -2.34375E-02, 4_" -23.438E-03")
+ call checkfmt("(rn,en15.3)", -9.765625E-04,4_" -976.562E-06")
+ call checkfmt("(rn,en15.6)", -2.9296875E-03,4_" -2.929688E-03")
+
+ print *, n_tst, n_cnt, n_skip
+ if (n_cnt /= 0) stop n_cnt
+ if (all(.not. l_skip)) print *, "All kinds rounded to nearest"
+
+contains
+ subroutine checkfmt(fmt, x, cmp)
+ implicit none
+ integer :: i
+ character(len=*), intent(in) :: fmt
+ real, intent(in) :: x
+ character(len=*, kind=4), intent(in) :: cmp
+ do i=1,size(real_kinds)
+ if (l_skip(i)) cycle
+ if (i == 1) then
+ write(s, fmt) real(x,kind=j(1))
+ else if (i == 2) then
+ write(s, fmt) real(x,kind=j(2))
+ else if (i == 3) then
+ write(s, fmt) real(x,kind=j(3))
+ else if (i == 4) then
+ write(s, fmt) real(x,kind=j(4))
+ end if
+ n_tst = n_tst + 1
+ if (s /= cmp) then
+ if (l_skip(i)) then
+ n_skip = n_skip + 1
+ else
+ print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
+ n_cnt = n_cnt + 1
+ end if
+ end if
+ end do
+
+ end subroutine
+end program
+! { dg-output "All kinds rounded to nearest" { xfail { i?86-*-solaris2.9* hppa*-*-hpux* } } }
+! { dg-final { cleanup-saved-temps } }
diff --git a/gcc/testsuite/gfortran.dg/fmt_en_ru.f90 b/gcc/testsuite/gfortran.dg/fmt_en_ru.f90
new file mode 100644
index 00000000000..7834e2880bd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_en_ru.f90
@@ -0,0 +1,185 @@
+! { dg-do run }
+! PR60128 Invalid outputs with EN descriptors
+! Test case provided by Walt Brainerd.
+program pr60128
+use ISO_FORTRAN_ENV
+ implicit none
+ integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]]
+ logical :: l_skip(4) = .false.
+ integer :: i
+ integer :: n_tst = 0, n_cnt = 0, n_skip = 0
+ character(len=20,kind=4) :: s, s1
+
+! Check that the default rounding mode is to nearest and to even on tie.
+ do i=1,size(real_kinds)
+ if (i == 1) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(1)), &
+ real(9.49999905,kind=j(1)), &
+ real(9.5,kind=j(1)), real(8.5,kind=j(1))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(1)), &
+ real(98765.0,kind=j(1))
+ else if (i == 2) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(2)), &
+ real(9.49999905,kind=j(2)), &
+ real(9.5,kind=j(2)), real(8.5,kind=j(2))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(2)), &
+ real(98765.0,kind=j(2))
+ else if (i == 3) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(3)), &
+ real(9.49999905,kind=j(3)), &
+ real(9.5,kind=j(3)), real(8.5,kind=j(3))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(3)), &
+ real(98765.0,kind=j(3))
+ else if (i == 4) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(4)), &
+ real(9.49999905,kind=j(4)), &
+ real(9.5,kind=j(4)), real(8.5,kind=j(4))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(4)), &
+ real(98765.0,kind=j(4))
+ end if
+ if (s /= 4_'-9.5 9.5 10. 8.' .or. s1 /= 4_' 987.4E+03 98.76E+03') then
+ l_skip(i) = .true.
+ print "('Unsupported rounding for real(',i0,')')", j(i)
+ end if
+ end do
+
+
+! Original test.
+ call checkfmt("(en15.2)", -.44444, 4_" -444.44E-03")
+
+! Test for the bug in comment 6.
+ call checkfmt("(ru,en15.0)", 1.0, 4_" 1.E+00")
+ call checkfmt("(ru,en15.0)", 1.00000012, 4_" 2.E+00")
+ call checkfmt("(ru,en15.0)", 0.99999994, 4_" 1.E+00")
+ call checkfmt("(ru,en15.0)", 10.0, 4_" 10.E+00")
+ call checkfmt("(ru,en15.0)", 10.0000010, 4_" 11.E+00")
+ call checkfmt("(ru,en15.0)", 9.99999905, 4_" 10.E+00")
+ call checkfmt("(ru,en15.0)", 100.0, 4_" 100.E+00")
+ call checkfmt("(ru,en15.0)", 100.000008, 4_" 101.E+00")
+ call checkfmt("(ru,en15.0)", 99.9999924, 4_" 100.E+00")
+ call checkfmt("(ru,en15.0)", 1000.0, 4_" 1.E+03")
+ call checkfmt("(ru,en15.0)", 1000.00006, 4_" 2.E+03")
+ call checkfmt("(ru,en15.0)", 999.999939, 4_" 1.E+03")
+ call checkfmt("(ru,en15.0)", 9.5, 4_" 10.E+00")
+ call checkfmt("(ru,en15.0)", 9.50000095, 4_" 10.E+00")
+ call checkfmt("(ru,en15.0)", 9.49999905, 4_" 10.E+00")
+ call checkfmt("(ru,en15.0)", 99.5, 4_" 100.E+00")
+ call checkfmt("(ru,en15.0)", 99.5000076, 4_" 100.E+00")
+ call checkfmt("(ru,en15.0)", 99.4999924, 4_" 100.E+00")
+ call checkfmt("(ru,en15.0)", 999.5, 4_" 1.E+03")
+ call checkfmt("(ru,en15.0)", 999.500061, 4_" 1.E+03")
+ call checkfmt("(ru,en15.0)", 999.499939, 4_" 1.E+03")
+ call checkfmt("(ru,en15.0)", 9500.0, 4_" 10.E+03")
+ call checkfmt("(ru,en15.0)", 9500.00098, 4_" 10.E+03")
+ call checkfmt("(ru,en15.0)", 9499.99902, 4_" 10.E+03")
+ call checkfmt("(ru,en15.1)", 9950.0, 4_" 10.0E+03")
+ call checkfmt("(ru,en15.2)", 9995.0, 4_" 10.00E+03")
+ call checkfmt("(ru,en15.3)", 9999.5, 4_" 10.000E+03")
+ call checkfmt("(ru,en15.1)", 9.5, 4_" 9.5E+00")
+ call checkfmt("(ru,en15.1)", 9.50000095, 4_" 9.6E+00")
+ call checkfmt("(ru,en15.1)", 9.49999905, 4_" 9.5E+00")
+ call checkfmt("(ru,en15.1)", 0.099951, 4_" 100.0E-03")
+ call checkfmt("(ru,en15.1)", 0.009951, 4_" 10.0E-03")
+ call checkfmt("(ru,en15.1)", 0.000999951,4_" 1.0E-03")
+
+ call checkfmt("(ru,en15.0)", -1.0, 4_" -1.E+00")
+ call checkfmt("(ru,en15.0)", -1.00000012, 4_" -1.E+00")
+ call checkfmt("(ru,en15.0)", -0.99999994, 4_" -999.E-03")
+ call checkfmt("(ru,en15.0)", -10.0, 4_" -10.E+00")
+ call checkfmt("(ru,en15.0)", -10.0000010, 4_" -10.E+00")
+ call checkfmt("(ru,en15.0)", -9.99999905, 4_" -9.E+00")
+ call checkfmt("(ru,en15.0)", -100.0, 4_" -100.E+00")
+ call checkfmt("(ru,en15.0)", -100.000008, 4_" -100.E+00")
+ call checkfmt("(ru,en15.0)", -99.9999924, 4_" -99.E+00")
+ call checkfmt("(ru,en15.0)", -1000.0, 4_" -1.E+03")
+ call checkfmt("(ru,en15.0)", -1000.00006, 4_" -1.E+03")
+ call checkfmt("(ru,en15.0)", -999.999939, 4_" -999.E+00")
+ call checkfmt("(ru,en15.0)", -9.5, 4_" -9.E+00")
+ call checkfmt("(ru,en15.0)", -9.50000095, 4_" -9.E+00")
+ call checkfmt("(ru,en15.0)", -9.49999905, 4_" -9.E+00")
+ call checkfmt("(ru,en15.0)", -99.5, 4_" -99.E+00")
+ call checkfmt("(ru,en15.0)", -99.5000076, 4_" -99.E+00")
+ call checkfmt("(ru,en15.0)", -99.4999924, 4_" -99.E+00")
+ call checkfmt("(ru,en15.0)", -999.5, 4_" -999.E+00")
+ call checkfmt("(ru,en15.0)", -999.500061, 4_" -999.E+00")
+ call checkfmt("(ru,en15.0)", -999.499939, 4_" -999.E+00")
+ call checkfmt("(ru,en15.0)", -9500.0, 4_" -9.E+03")
+ call checkfmt("(ru,en15.0)", -9500.00098, 4_" -9.E+03")
+ call checkfmt("(ru,en15.0)", -9499.99902, 4_" -9.E+03")
+ call checkfmt("(ru,en15.1)", -9950.0, 4_" -9.9E+03")
+ call checkfmt("(ru,en15.2)", -9995.0, 4_" -9.99E+03")
+ call checkfmt("(ru,en15.3)", -9999.5, 4_" -9.999E+03")
+ call checkfmt("(ru,en15.1)", -9.5, 4_" -9.5E+00")
+ call checkfmt("(ru,en15.1)", -9.50000095, 4_" -9.5E+00")
+ call checkfmt("(ru,en15.1)", -9.49999905, 4_" -9.4E+00")
+ call checkfmt("(ru,en15.1)", -0.099951, 4_" -99.9E-03")
+ call checkfmt("(ru,en15.1)", -0.009951, 4_" -9.9E-03")
+ call checkfmt("(ru,en15.1)", -0.000999951,4_" -999.9E-06")
+
+ call checkfmt("(ru,en15.1)", 987350., 4_" 987.4E+03")
+ call checkfmt("(ru,en15.2)", 98735., 4_" 98.74E+03")
+ call checkfmt("(ru,en15.3)", 9873.5, 4_" 9.874E+03")
+ call checkfmt("(ru,en15.1)", 987650., 4_" 987.7E+03")
+ call checkfmt("(ru,en15.2)", 98765., 4_" 98.77E+03")
+ call checkfmt("(ru,en15.3)", 9876.5, 4_" 9.877E+03")
+ call checkfmt("(ru,en15.1)", 3.125E-02, 4_" 31.3E-03")
+ call checkfmt("(ru,en15.1)", 9.375E-02, 4_" 93.8E-03")
+ call checkfmt("(ru,en15.2)", 1.5625E-02, 4_" 15.63E-03")
+ call checkfmt("(ru,en15.2)", 4.6875E-02, 4_" 46.88E-03")
+ call checkfmt("(ru,en15.3)", 7.8125E-03, 4_" 7.813E-03")
+ call checkfmt("(ru,en15.3)", 2.34375E-02, 4_" 23.438E-03")
+ call checkfmt("(ru,en15.3)", 9.765625E-04,4_" 976.563E-06")
+ call checkfmt("(ru,en15.6)", 2.9296875E-03,4_" 2.929688E-03")
+
+ call checkfmt("(ru,en15.1)", -987350., 4_" -987.3E+03")
+ call checkfmt("(ru,en15.2)", -98735., 4_" -98.73E+03")
+ call checkfmt("(ru,en15.3)", -9873.5, 4_" -9.873E+03")
+ call checkfmt("(ru,en15.1)", -987650., 4_" -987.6E+03")
+ call checkfmt("(ru,en15.2)", -98765., 4_" -98.76E+03")
+ call checkfmt("(ru,en15.3)", -9876.5, 4_" -9.876E+03")
+ call checkfmt("(ru,en15.1)", -3.125E-02, 4_" -31.2E-03")
+ call checkfmt("(ru,en15.1)", -9.375E-02, 4_" -93.7E-03")
+ call checkfmt("(ru,en15.2)", -1.5625E-02, 4_" -15.62E-03")
+ call checkfmt("(ru,en15.2)", -4.6875E-02, 4_" -46.87E-03")
+ call checkfmt("(ru,en15.3)", -7.8125E-03, 4_" -7.812E-03")
+ call checkfmt("(ru,en15.3)", -2.34375E-02, 4_" -23.437E-03")
+ call checkfmt("(ru,en15.3)", -9.765625E-04,4_" -976.562E-06")
+ call checkfmt("(ru,en15.6)", -2.9296875E-03,4_" -2.929687E-03")
+
+ print *, n_tst, n_cnt, n_skip
+ if (n_cnt /= 0) stop n_cnt
+ if (all(.not. l_skip)) print *, "All kinds rounded up"
+
+contains
+ subroutine checkfmt(fmt, x, cmp)
+ implicit none
+ integer :: i
+ character(len=*), intent(in) :: fmt
+ real, intent(in) :: x
+ character(len=*, kind=4), intent(in) :: cmp
+ do i=1,size(real_kinds)
+ if (l_skip(i)) cycle
+ if (i == 1) then
+ write(s, fmt) real(x,kind=j(1))
+ else if (i == 2) then
+ write(s, fmt) real(x,kind=j(2))
+ else if (i == 3) then
+ write(s, fmt) real(x,kind=j(3))
+ else if (i == 4) then
+ write(s, fmt) real(x,kind=j(4))
+ end if
+ n_tst = n_tst + 1
+ if (s /= cmp) then
+ if (l_skip(i)) then
+ n_skip = n_skip + 1
+ else
+ print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
+ n_cnt = n_cnt + 1
+ end if
+ end if
+ end do
+
+ end subroutine
+end program
+! { dg-output "All kinds rounded up" { xfail { i?86-*-solaris2.9* hppa*-*-hpux* } } }
+! { dg-final { cleanup-saved-temps } }
diff --git a/gcc/testsuite/gfortran.dg/fmt_en_rz.f90 b/gcc/testsuite/gfortran.dg/fmt_en_rz.f90
new file mode 100644
index 00000000000..c07847cad6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_en_rz.f90
@@ -0,0 +1,185 @@
+! { dg-do run }
+! PR60128 Invalid outputs with EN descriptors
+! Test case provided by Walt Brainerd.
+program pr60128
+use ISO_FORTRAN_ENV
+ implicit none
+ integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]]
+ logical :: l_skip(4) = .false.
+ integer :: i
+ integer :: n_tst = 0, n_cnt = 0, n_skip = 0
+ character(len=20,kind=4) :: s, s1
+
+! Check that the default rounding mode is to nearest and to even on tie.
+ do i=1,size(real_kinds)
+ if (i == 1) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(1)), &
+ real(9.49999905,kind=j(1)), &
+ real(9.5,kind=j(1)), real(8.5,kind=j(1))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(1)), &
+ real(98765.0,kind=j(1))
+ else if (i == 2) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(2)), &
+ real(9.49999905,kind=j(2)), &
+ real(9.5,kind=j(2)), real(8.5,kind=j(2))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(2)), &
+ real(98765.0,kind=j(2))
+ else if (i == 3) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(3)), &
+ real(9.49999905,kind=j(3)), &
+ real(9.5,kind=j(3)), real(8.5,kind=j(3))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(3)), &
+ real(98765.0,kind=j(3))
+ else if (i == 4) then
+ write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(4)), &
+ real(9.49999905,kind=j(4)), &
+ real(9.5,kind=j(4)), real(8.5,kind=j(4))
+ write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(4)), &
+ real(98765.0,kind=j(4))
+ end if
+ if (s /= 4_'-9.5 9.5 10. 8.' .or. s1 /= 4_' 987.4E+03 98.76E+03') then
+ l_skip(i) = .true.
+ print "('Unsupported rounding for real(',i0,')')", j(i)
+ end if
+ end do
+
+
+! Original test.
+ call checkfmt("(en15.2)", -.44444, 4_" -444.44E-03")
+
+! Test for the bug in comment 6.
+ call checkfmt("(rz,en15.0)", 1.0, 4_" 1.E+00")
+ call checkfmt("(rz,en15.0)", 1.00000012, 4_" 1.E+00")
+ call checkfmt("(rz,en15.0)", 0.99999994, 4_" 999.E-03")
+ call checkfmt("(rz,en15.0)", 10.0, 4_" 10.E+00")
+ call checkfmt("(rz,en15.0)", 10.0000010, 4_" 10.E+00")
+ call checkfmt("(rz,en15.0)", 9.99999905, 4_" 9.E+00")
+ call checkfmt("(rz,en15.0)", 100.0, 4_" 100.E+00")
+ call checkfmt("(rz,en15.0)", 100.000008, 4_" 100.E+00")
+ call checkfmt("(rz,en15.0)", 99.9999924, 4_" 99.E+00")
+ call checkfmt("(rz,en15.0)", 1000.0, 4_" 1.E+03")
+ call checkfmt("(rz,en15.0)", 1000.00006, 4_" 1.E+03")
+ call checkfmt("(rz,en15.0)", 999.999939, 4_" 999.E+00")
+ call checkfmt("(rz,en15.0)", 9.5, 4_" 9.E+00")
+ call checkfmt("(rz,en15.0)", 9.50000095, 4_" 9.E+00")
+ call checkfmt("(rz,en15.0)", 9.49999905, 4_" 9.E+00")
+ call checkfmt("(rz,en15.0)", 99.5, 4_" 99.E+00")
+ call checkfmt("(rz,en15.0)", 99.5000076, 4_" 99.E+00")
+ call checkfmt("(rz,en15.0)", 99.4999924, 4_" 99.E+00")
+ call checkfmt("(rz,en15.0)", 999.5, 4_" 999.E+00")
+ call checkfmt("(rz,en15.0)", 999.500061, 4_" 999.E+00")
+ call checkfmt("(rz,en15.0)", 999.499939, 4_" 999.E+00")
+ call checkfmt("(rz,en15.0)", 9500.0, 4_" 9.E+03")
+ call checkfmt("(rz,en15.0)", 9500.00098, 4_" 9.E+03")
+ call checkfmt("(rz,en15.0)", 9499.99902, 4_" 9.E+03")
+ call checkfmt("(rz,en15.1)", 9950.0, 4_" 9.9E+03")
+ call checkfmt("(rz,en15.2)", 9995.0, 4_" 9.99E+03")
+ call checkfmt("(rz,en15.3)", 9999.5, 4_" 9.999E+03")
+ call checkfmt("(rz,en15.1)", 9.5, 4_" 9.5E+00")
+ call checkfmt("(rz,en15.1)", 9.50000095, 4_" 9.5E+00")
+ call checkfmt("(rz,en15.1)", 9.49999905, 4_" 9.4E+00")
+ call checkfmt("(rz,en15.1)", 0.099951, 4_" 99.9E-03")
+ call checkfmt("(rz,en15.1)", 0.009951, 4_" 9.9E-03")
+ call checkfmt("(rz,en15.1)", 0.000999951,4_" 999.9E-06")
+
+ call checkfmt("(rz,en15.0)", -1.0, 4_" -1.E+00")
+ call checkfmt("(rz,en15.0)", -1.00000012, 4_" -1.E+00")
+ call checkfmt("(rz,en15.0)", -0.99999994, 4_" -999.E-03")
+ call checkfmt("(rz,en15.0)", -10.0, 4_" -10.E+00")
+ call checkfmt("(rz,en15.0)", -10.0000010, 4_" -10.E+00")
+ call checkfmt("(rz,en15.0)", -9.99999905, 4_" -9.E+00")
+ call checkfmt("(rz,en15.0)", -100.0, 4_" -100.E+00")
+ call checkfmt("(rz,en15.0)", -100.000008, 4_" -100.E+00")
+ call checkfmt("(rz,en15.0)", -99.9999924, 4_" -99.E+00")
+ call checkfmt("(rz,en15.0)", -1000.0, 4_" -1.E+03")
+ call checkfmt("(rz,en15.0)", -1000.00006, 4_" -1.E+03")
+ call checkfmt("(rz,en15.0)", -999.999939, 4_" -999.E+00")
+ call checkfmt("(rz,en15.0)", -9.5, 4_" -9.E+00")
+ call checkfmt("(rz,en15.0)", -9.50000095, 4_" -9.E+00")
+ call checkfmt("(rz,en15.0)", -9.49999905, 4_" -9.E+00")
+ call checkfmt("(rz,en15.0)", -99.5, 4_" -99.E+00")
+ call checkfmt("(rz,en15.0)", -99.5000076, 4_" -99.E+00")
+ call checkfmt("(rz,en15.0)", -99.4999924, 4_" -99.E+00")
+ call checkfmt("(rz,en15.0)", -999.5, 4_" -999.E+00")
+ call checkfmt("(rz,en15.0)", -999.500061, 4_" -999.E+00")
+ call checkfmt("(rz,en15.0)", -999.499939, 4_" -999.E+00")
+ call checkfmt("(rz,en15.0)", -9500.0, 4_" -9.E+03")
+ call checkfmt("(rz,en15.0)", -9500.00098, 4_" -9.E+03")
+ call checkfmt("(rz,en15.0)", -9499.99902, 4_" -9.E+03")
+ call checkfmt("(rz,en15.1)", -9950.0, 4_" -9.9E+03")
+ call checkfmt("(rz,en15.2)", -9995.0, 4_" -9.99E+03")
+ call checkfmt("(rz,en15.3)", -9999.5, 4_" -9.999E+03")
+ call checkfmt("(rz,en15.1)", -9.5, 4_" -9.5E+00")
+ call checkfmt("(rz,en15.1)", -9.50000095, 4_" -9.5E+00")
+ call checkfmt("(rz,en15.1)", -9.49999905, 4_" -9.4E+00")
+ call checkfmt("(rz,en15.1)", -0.099951, 4_" -99.9E-03")
+ call checkfmt("(rz,en15.1)", -0.009951, 4_" -9.9E-03")
+ call checkfmt("(rz,en15.1)", -0.000999951,4_" -999.9E-06")
+
+ call checkfmt("(rz,en15.1)", 987350., 4_" 987.3E+03")
+ call checkfmt("(rz,en15.2)", 98735., 4_" 98.73E+03")
+ call checkfmt("(rz,en15.3)", 9873.5, 4_" 9.873E+03")
+ call checkfmt("(rz,en15.1)", 987650., 4_" 987.6E+03")
+ call checkfmt("(rz,en15.2)", 98765., 4_" 98.76E+03")
+ call checkfmt("(rz,en15.3)", 9876.5, 4_" 9.876E+03")
+ call checkfmt("(rz,en15.1)", 3.125E-02, 4_" 31.2E-03")
+ call checkfmt("(rz,en15.1)", 9.375E-02, 4_" 93.7E-03")
+ call checkfmt("(rz,en15.2)", 1.5625E-02, 4_" 15.62E-03")
+ call checkfmt("(rz,en15.2)", 4.6875E-02, 4_" 46.87E-03")
+ call checkfmt("(rz,en15.3)", 7.8125E-03, 4_" 7.812E-03")
+ call checkfmt("(rz,en15.3)", 2.34375E-02, 4_" 23.437E-03")
+ call checkfmt("(rz,en15.3)", 9.765625E-04,4_" 976.562E-06")
+ call checkfmt("(rz,en15.6)", 2.9296875E-03,4_" 2.929687E-03")
+
+ call checkfmt("(rz,en15.1)", -987350., 4_" -987.3E+03")
+ call checkfmt("(rz,en15.2)", -98735., 4_" -98.73E+03")
+ call checkfmt("(rz,en15.3)", -9873.5, 4_" -9.873E+03")
+ call checkfmt("(rz,en15.1)", -987650., 4_" -987.6E+03")
+ call checkfmt("(rz,en15.2)", -98765., 4_" -98.76E+03")
+ call checkfmt("(rz,en15.3)", -9876.5, 4_" -9.876E+03")
+ call checkfmt("(rz,en15.1)", -3.125E-02, 4_" -31.2E-03")
+ call checkfmt("(rz,en15.1)", -9.375E-02, 4_" -93.7E-03")
+ call checkfmt("(rz,en15.2)", -1.5625E-02, 4_" -15.62E-03")
+ call checkfmt("(rz,en15.2)", -4.6875E-02, 4_" -46.87E-03")
+ call checkfmt("(rz,en15.3)", -7.8125E-03, 4_" -7.812E-03")
+ call checkfmt("(rz,en15.3)", -2.34375E-02, 4_" -23.437E-03")
+ call checkfmt("(rz,en15.3)", -9.765625E-04,4_" -976.562E-06")
+ call checkfmt("(rz,en15.6)", -2.9296875E-03,4_" -2.929687E-03")
+
+ print *, n_tst, n_cnt, n_skip
+ if (n_cnt /= 0) stop n_cnt
+ if (all(.not. l_skip)) print *, "All kinds rounded to zero"
+
+contains
+ subroutine checkfmt(fmt, x, cmp)
+ implicit none
+ integer :: i
+ character(len=*), intent(in) :: fmt
+ real, intent(in) :: x
+ character(len=*, kind=4), intent(in) :: cmp
+ do i=1,size(real_kinds)
+ if (l_skip(i)) cycle
+ if (i == 1) then
+ write(s, fmt) real(x,kind=j(1))
+ else if (i == 2) then
+ write(s, fmt) real(x,kind=j(2))
+ else if (i == 3) then
+ write(s, fmt) real(x,kind=j(3))
+ else if (i == 4) then
+ write(s, fmt) real(x,kind=j(4))
+ end if
+ n_tst = n_tst + 1
+ if (s /= cmp) then
+ if (l_skip(i)) then
+ n_skip = n_skip + 1
+ else
+ print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
+ n_cnt = n_cnt + 1
+ end if
+ end if
+ end do
+
+ end subroutine
+end program
+! { dg-output "All kinds rounded to zero" { xfail { i?86-*-solaris2.9* hppa*-*-hpux* } } }
+! { dg-final { cleanup-saved-temps } }
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index 8a1be054371..3311db31209 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -399,7 +399,8 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
updown:
rchar = '0';
- if (ft != FMT_F && w > 0 && d == 0 && p == 0)
+ /* Do not reset nbefore for FMT_F and FMT_EN. */
+ if (ft != FMT_F && ft !=FMT_EN && w > 0 && d == 0 && p == 0)
nbefore = 1;
/* Scan for trailing zeros to see if we really need to round it. */
for(i = nbefore + nafter; i < ndigits; i++)
More information about the Gcc-cvs
mailing list