diff options
| author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2016-09-06 23:22:26 +0000 |
|---|---|---|
| committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2016-09-06 23:22:26 +0000 |
| commit | 5dcf68f510d9f02cbccb9355bc629a83c3c4cdb4 (patch) | |
| tree | 974e99bcdef6567e75b66f7e17b71216ef5bd746 | |
| parent | 6ac7322b3ece979c1adf381f7c6c7e421cf9922f (diff) | |
| download | gcc-5dcf68f510d9f02cbccb9355bc629a83c3c4cdb4.zip gcc-5dcf68f510d9f02cbccb9355bc629a83c3c4cdb4.tar.gz gcc-5dcf68f510d9f02cbccb9355bc629a83c3c4cdb4.tar.bz2 | |
re PR libfortran/77393 (Revision r237735 changed the behavior of F0.0)
2016-09-06 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/77393
* io/write_float.def (build_float_string): Recognize when the
result will not fit in the user provided, star fill, and exit
early.
* gfortran.dg/fmt_f0_2.f90: Update test.
* gfortran.dg/fmt_f0_3.f90: New test.
From-SVN: r240018
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/fmt_f0_2.f90 | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/fmt_f0_3.f90 | 23 | ||||
| -rw-r--r-- | libgfortran/ChangeLog | 7 | ||||
| -rw-r--r-- | libgfortran/io/write_float.def | 7 |
5 files changed, 43 insertions, 4 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ff8bc00..b5157f6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2016-09-16 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR libgfortran/77393 + * gfortran.dg/fmt_f0_2.f90: Update test. + * gfortran.dg/fmt_f0_3.f90: New test. + 2016-09-07 Dominique d'Humieres <dominiq@lps.ens.fr> PR debug/77389 diff --git a/gcc/testsuite/gfortran.dg/fmt_f0_2.f90 b/gcc/testsuite/gfortran.dg/fmt_f0_2.f90 index 01788fa..4afba913 100644 --- a/gcc/testsuite/gfortran.dg/fmt_f0_2.f90 +++ b/gcc/testsuite/gfortran.dg/fmt_f0_2.f90 @@ -11,16 +11,12 @@ program testbigf0 ! Can enormous numbers be printed with F0.0 format? select case (i) case (1) write(str, "(f0.0)") -huge(real(1.0,kind=j(1))) - if (len(trim(str)).lt.41) error stop "FAILED AT LINE 15" case (2) write(str, "(f0.0)") -huge(real(1.0,kind=j(2))) - if (len(trim(str)).lt.311) error stop "FAILED AT LINE 19" case (3) write(str, "(f0.0)") -huge(real(1.0,kind=j(3))) - if (len(trim(str)).lt.4935) error stop "FAILED AT LINE 23" case (4) write(str, "(f0.10)") -huge(real(1.0,kind=j(4))) - if (len(trim(str)).lt.4945) error stop "FAILED AT LINE 27" end select enddo end program testbigf0 diff --git a/gcc/testsuite/gfortran.dg/fmt_f0_3.f90 b/gcc/testsuite/gfortran.dg/fmt_f0_3.f90 new file mode 100644 index 0000000..905fe73 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fmt_f0_3.f90 @@ -0,0 +1,23 @@ +! { dg-do run } +! PR77393, this segfaulted before +program testbigf0 + use ISO_FORTRAN_ENV + implicit none + integer i + integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]] + character(10000) :: str + + do i=1,size(real_kinds) + select case (i) + case (1) + write(str, "(f8.0)") huge(real(1.0,kind=j(1))) + case (2) + write(str, "(f18.0)") huge(real(1.0,kind=j(2))) + case (3) + write(str, "(f20.0)") huge(real(1.0,kind=j(3))) + case (4) + write(str, "(f40.0)") huge(real(1.0,kind=j(4))) + end select + enddo +end program testbigf0 + diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 256805a..f9ed4b0 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2016-09-16 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR libgfortran/77393 + * io/write_float.def (build_float_string): Recognize when the + result will not fit in the user provided, star fill, and exit + early. + 2016-08-31 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR libgfortran/77393 diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def index 04223c0..504482f 100644 --- a/libgfortran/io/write_float.def +++ b/libgfortran/io/write_float.def @@ -174,6 +174,13 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer, { case FMT_F: nbefore = ndigits - precision; + if ((w > 0) && (nbefore > (int) size)) + { + *len = w; + star_fill (result, w); + result[w] = '\0'; + return; + } /* Make sure the decimal point is a '.'; depending on the locale, this might not be the case otherwise. */ digits[nbefore] = '.'; |