[Patch, fortran] 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.
I am not set up to commit on git, someone will have to do it for me.
TIA
Dominique
--- ../_clean/libgfortran/io/write_float.def 2020-06-13 03:11:55.0 +0200
+++ libgfortran/io/write_float.def 2020-07-21 23:03:08.0 +0200
@@ -399,7 +399,8 @@ build_float_string (st_parameter_dt *dtp
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++)
--- ../_clean/gcc/testsuite/gfortran.dg/fmt_en.f90 2020-06-13 03:11:53.0 +0200
+++ gcc/testsuite/gfortran.dg/fmt_en.f90 2020-06-15 16:55:35.0 +0200
@@ -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* } } }
--- ../_clean/gcc/testsuite/gfortran.dg/fmt_en_rd.f90 1970-01-01 01:00:00.0 +0100
+++ gcc/testsuite/gfortran.dg/fmt_en_rd.f90 2020-07-19 23:51:17.0 +0200
@@ -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.4905,kind=j(1)), &
+ real(9.4905,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.4905,kind=j(2)), &
+ real(9.4905,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.4905,kind=j(3)), &
+ real(9.4905,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.4905,kind=j(4)), &
+ real(9.4905,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)", -.4,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.0012, 4_" 1.E+00")
+call checkfmt("(rd,en15.0)", 0.9994, 4_" 999.E-03")
+call checkfmt("(rd,en15.0)", 10.0, 4_"10.E+00")
+call checkfmt("(rd,en15.0)", 10.010, 4_"10.E+00")
+call checkfmt("(rd,en15.0)", 9.9905, 4_" 9.E+00")
+call checkfmt("(ru,en15.0)", 100.0, 4_" 100.E+00")
+call checkfmt("(rd,en15.0)", 100.08, 4_" 100.E+00")
+call checkfmt("(rd,en15.0)", 99.924, 4_"99.E+00")
+call checkfmt("(rd,en15.0)", 1000.0, 4_" 1.E+03")
+call checkfmt("(rd,en15.0)", 1000.6, 4_" 1.E+03")
+call
[Patch fortran] PR 93567 - G edit descriptor uses E instead of F editing in rounding mode UP
I am not set up to commit on git, someone will have to do it for me.
TIA
Dominique
--- ../_clean/libgfortran/io/write_float.def 2020-06-13 03:11:55.0 +0200
+++ libgfortran/io/write_float.def 2020-07-21 23:03:08.0 +0200
@@ -987,16 +987,19 @@ determine_en_precision (st_parameter_dt
w = default_width;\
d = precision;\
}\
+ /* The switch between FMT_E and FMT_F is based on the absolute value. \
+ Set r=0 for rounding toward zero and r = 1 otherwise. \
+ If (exp_d - m) == 1 there is no rounding needed. */\
switch (dtp->u.p.current_unit->round_status)\
{\
case ROUND_ZERO:\
- r = sign_bit ? 1.0 : 0.0;\
+ r = 0.0;\
break;\
case ROUND_UP:\
- r = 1.0;\
+ r = sign_bit ? 0.0 : 1.0;\
break;\
case ROUND_DOWN:\
- r = 0.0;\
+ r = sign_bit ? 1.0 : 0.0;\
break;\
default:\
break;\
@@ -1004,7 +1007,8 @@ determine_en_precision (st_parameter_dt
exp_d = calculate_exp_ ## x (d);\
r_sc = (1 - r / exp_d);\
temp = 0.1 * r_sc;\
- if ((m > 0.0 && ((m < temp) || (r >= (exp_d - m\
+ if ((m > 0.0 && ((m < temp) || (r < 1 && r >= (exp_d - m))\
+ || (r == 1 && 1 > (exp_d - m\
|| ((m == 0.0) && !(compile_options.allow_std\
& (GFC_STD_F2003 | GFC_STD_F2008)))\
|| d == 0)\
--- ../_clean/gcc/testsuite/gfortran.dg/round_3.f08 2020-06-13 03:11:54.0 +0200
+++ gcc/testsuite/gfortran.dg/round_3.f08 2020-07-21 01:14:56.0 +0200
@@ -110,6 +110,30 @@ program pr48615
call checkfmt("(RU,E17.1)", nearest(2.0, 1.0), " 0.3E+01")
call checkfmt("(RD,E17.1)", nearest(3.0, -1.0)," 0.2E+01")
+call checkfmt("(G12.2)", 99.0, " 99.")
+call checkfmt("(G12.2)", 99.5, "0.10E+03")
+call checkfmt("(G12.2)", 100.0, "0.10E+03")
+call checkfmt("(G12.2)", -99.0, "-99.")
+call checkfmt("(G12.2)", -99.5, " -0.10E+03")
+call checkfmt("(G12.2)", -100.0, " -0.10E+03")
+call checkfmt("(RU,G12.2)", 99.0," 99.")! pr93567
+call checkfmt("(RU,G12.2)", 99.01, "0.10E+03")
+call checkfmt("(RU,G12.2)", -99.0, "-99.")
+call checkfmt("(RU,G12.2)", -99.01, "-99.")
+call checkfmt("(RU,G12.2)", -100.01, " -0.10E+03")
+call checkfmt("(RU,G12.4)", 99.0 , " 99.00")
+call checkfmt("(RU,G12.4)", 99.01, " 99.02")
+call checkfmt("(RD,G12.2)", 99.0," 99.")
+call checkfmt("(RD,G12.2)", 99.01, " 99.")
+call checkfmt("(RD,G12.2)", 100.01, "0.10E+03")
+call checkfmt("(RD,G12.2)", -99.0, "-99.")
+call checkfmt("(RD,G12.2)", -99.01, " -0.10E+03")
+call checkfmt("(RD,G12.2)", -100.00, " -0.10E+03")
+call checkfmt("(Rz,G12.2)", 99.01, " 99.")
+call checkfmt("(Rz,G12.2)", 100.01, "0.10E+03")
+call checkfmt("(Rz,G12.2)", -99.01, "-99.")
+call checkfmt("(Rz,G12.2)", -100.01, " -0.10E+03")
+
contains
subroutine checkfmt(fmt, x, cmp)
character(len=*), intent(in) :: fmt
@@ -119,6 +143,6 @@ contains
write(s, fmt) x
if (s /= cmp) STOP 1
-!if (s /= cmp) print "(a,1x,a,' expected: ',1x)", fmt, s, cmp
+!if (s /= cmp) print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
end subroutine
end program
Re: [Patch, fortran] PR 93592 - Invalid UP/DOWN rounding with EN descriptor
Le 2020-07-24 20:50, Thomas Koenig a écrit : Hi Dominique, I have committed the patch after regression-testing. Thanks. Dou you want to backport this, as well? IMO it is worth the work. (And if one of my e-mails bounced, you can try the other one. What is the other one? Dominique Originally, I wanted to switch completely, but the bouncing problem made that impossible...) Best regards Thomas
Re: [Patch, fortran] PR 93592 - Invalid UP/DOWN rounding with EN descriptor
Le 2020-07-25 13:54, Thomas Koenig a écrit : Am 24.07.20 um 23:19 schrieb dhumieres.domini...@free.fr: Le 2020-07-24 20:50, Thomas Koenig a écrit : Hi Dominique, I have committed the patch after regression-testing. Thanks. Dou you want to backport this, as well? IMO it is worth the work. OK. The patch for PR 93592 is now committed down to gcc-8. The patch for 93567 only applied cleanly to trunk and gcc-10, where I have also committed it there. If you want to backport it further and want me to commit this, I will need a modified version of the patch. Thanks. I have closed the PRs as fixed. (And if one of my e-mails bounced, you can try the other one. What is the other one? I currently use tkoe...@netcologne.de and t...@tkoenig.net somewhat interchangably. I'm not sure which one bounces your e-mails; I hope one of them works. I am trying t...@tkoenig.net. Cheers, Dominique Thanks a lot for taking on these bugs! Best regards Thomas
Re: [RFC patch] Clean all (sub)?module files
Le 2020-06-27 13:34, Thomas Koenig a écrit : Hi Dominieque, While investigating pr95538, I see several module files that were not cleaned. Several were cleaned by a patch I had in my working directory. However new ones were not cleaned (e.g., gfortran.dg/pr95091.f90) due to continuation lines. This is now fixed with the attached patch (patch-mod). Thanks for working on this. My problem is that I my dejagnu-fu is almost nonexistent, so I could, in theory, review and commit this, but I do not really understand what you did. So, maybe if somebody more knowledgable about this could this could comment on Hi Thomas, Thanks for having a look. The patch is for two Tcl procedures, thus have very little to do with dejagnu. It is basically related to Tcl and regular expressions. If you want to refresh your Tcl you may want to look, e.g., http://www.tcl-lang.org/man/tcl8.6/TclCmd/contents.htm The first part of the patch for the proc 'list-module-names-1' extends the existing procedure to handle additional-sources and aux-modules. In order to avoid too long lines, I have split the initial pattern 'pat' in four pieces. The second part of the patch is for the proc 'f90grep' (borrowed from dejagnu and renamed from igrep, as in grep -i) in order to handle (sun)?module with free-form continuation lines. I am fully aware that some user may find a way to break the proposed logic, however it does not introduce new Tcl error, nor new failure in the test suite, and it works as expected for the present test suite. I can take the responsibility of the patch if there is nobody to review it and I'll do my best if a new test introduce a regression. Cheers, Dominique PS. Handling continuations in fixed-form is certainly doable, but more complicated since you need to keep track of the previous line and it is not needed at the moment. https://gcc.gnu.org/pipermail/fortran/2020-June/054533.html ? Best regards Thomas
Re: *ping* [patch, fortran] PR 27318, warn if interfaces do not match
Le 2020-06-30 23:39, Thomas Koenig a écrit : OK, so here is an updated version, which includes the updated test cases. Anything else? OK for trunk? Nothing to report!-) Thanks for the patch, Dominique
