From 67732fbced89c42dabea4a3bc160da80d0db046a Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Thu, 7 Nov 2019 03:06:20 +0000 Subject: [PATCH] re PR libfortran/90374 (Fortran 2018: Support d0.d, e0.d, es0.d, en0.d, g0.d and ew.d e0 edit descriptors for output) 2019-11-06 Jerry DeLisle PR fortran/90374 * io.c (check_format): Allow zero width for D, E, EN, and ES specifiers as default and when -std=F2018 is given. Retain existing errors when using the -fdec family of flags. * libgfortran/io/format.c (parse_format_list): Relax format checking for zero width as default and when -std=f2018. io/format.h (format_token): Move definition to io.h. io/io.h (format_token): Add definition here to allow access to this definition at higher levels. Rename the declaration of write_real_g0 to write_real_w0 and add a new format_token argument, allowing higher level functions to pass in the token for handling of g0 vs the other zero width specifiers. io/transfer.c (formatted_transfer_scalar_write): Add checks for zero width and call write_real_w0 to handle it. io/write.c (write_real_g0): Remove. (write_real_w0): Add new, same as previous write_real_g0 except check format token to handle the g0 case. * gfortran.dg/fmt_error_10.f: Modify for new constraints. * gfortran.dg/fmt_error_7.f: Add dg-options "-std=f95". * gfortran.dg/fmt_error_9.f: Modify for new constraints. * gfortran.dg/fmt_zero_width.f90: New test. From-SVN: r277905 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/io.c | 33 ++++++++++++++---- gcc/testsuite/ChangeLog | 8 +++++ gcc/testsuite/gfortran.dg/fmt_error_10.f | 4 +-- gcc/testsuite/gfortran.dg/fmt_error_7.f | 4 ++- gcc/testsuite/gfortran.dg/fmt_error_9.f | 2 +- gcc/testsuite/gfortran.dg/fmt_zero_width.f90 | 36 ++++++++++++++++++++ libgfortran/ChangeLog | 17 +++++++++ libgfortran/io/format.c | 8 ++--- libgfortran/io/format.h | 16 --------- libgfortran/io/io.h | 18 ++++++++-- libgfortran/io/transfer.c | 22 +++++++++--- libgfortran/io/write.c | 25 +++++++++----- 13 files changed, 152 insertions(+), 48 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/fmt_zero_width.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f9f9da2a6ef..5023949d528 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2019-11-06 Jerry DeLisle + + PR fortran/90374 + * io.c (check_format): Allow zero width for D, E, EN, and ES + specifiers as default and when -std=F2018 is given. Retain + existing errors when using the -fdec family of flags. + 2019-11-03 Thomas Koenig PR fortran/92113 diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index b969a1a4738..57a3fdd5152 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -922,19 +922,38 @@ data_desc: if (u != FMT_POSINT) { + if (flag_dec) + { + if (flag_dec_format_defaults) + { + /* Assume a default width based on the variable size. */ + saved_token = u; + break; + } + else + { + gfc_error ("Positive width required in format " + "specifier %s at %L", token_to_string (t), + &format_locus); + saved_token = u; + goto fail; + } + } + + format_locus.nextc += format_string_pos; + if (!gfc_notify_std (GFC_STD_F2018, + "positive width required at %L", + &format_locus)) + { + saved_token = u; + goto fail; + } if (flag_dec_format_defaults) { /* Assume a default width based on the variable size. */ saved_token = u; break; } - - format_locus.nextc += format_string_pos; - gfc_error ("Positive width required in format " - "specifier %s at %L", token_to_string (t), - &format_locus); - saved_token = u; - goto fail; } u = format_lex (); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e40445337f6..6bb85a31803 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2019-11-06 Jerry DeLisle + + PR fortran/90374 + * gfortran.dg/fmt_error_10.f: Modify for new constraints. + * gfortran.dg/fmt_error_7.f: Add dg-options "-std=f95". + * gfortran.dg/fmt_error_9.f: Modify for new constraints. + * gfortran.dg/fmt_zero_width.f90: New test. + 2019-11-07 Joseph Myers * gcc.dg/asm-wide-1.c, gcc.dg/diagnostic-token-ranges.c, diff --git a/gcc/testsuite/gfortran.dg/fmt_error_10.f b/gcc/testsuite/gfortran.dg/fmt_error_10.f index 7ea6aec1220..6e1a5f60bea 100644 --- a/gcc/testsuite/gfortran.dg/fmt_error_10.f +++ b/gcc/testsuite/gfortran.dg/fmt_error_10.f @@ -18,9 +18,9 @@ str = '(1pd0.15)' write (line,str,iostat=istat, iomsg=msg) 1.0d0 - if (istat.ne.5006 .or. msg(1:15).ne."Positive width ") STOP 5 + if (line.ne."1.000000000000000") STOP 5 read (*,str,iostat=istat, iomsg=msg) x - if (istat.ne.5006 .or. msg(1:15).ne."Positive width ") STOP 6 + if (istat.ne.5006 .or. msg(1:10).ne."Zero width") STOP 6 if (x.ne.555.25) STOP 7 write (line,'(1pd24.15e11.3)') 1.0d0, 1.234 diff --git a/gcc/testsuite/gfortran.dg/fmt_error_7.f b/gcc/testsuite/gfortran.dg/fmt_error_7.f index 9b5fba97e25..3937c8fe750 100644 --- a/gcc/testsuite/gfortran.dg/fmt_error_7.f +++ b/gcc/testsuite/gfortran.dg/fmt_error_7.f @@ -1,7 +1,9 @@ ! { dg-do compile } +! { dg-options "-std=f95" } + ! PR37446 Diagnostic of edit descriptors, esp. EN character(40) :: fmt_string write(*, '(1P,2E12.4)') 1.0 - write(*,'(EN)') 5.0 ! { dg-error "Positive width required" } + write(*,'(EN)') 5.0 ! { dg-error "positive width required" } write(*,'("abcdefg",EN6,"hjjklmnop")') 5.0 ! { dg-error "Period required" } end diff --git a/gcc/testsuite/gfortran.dg/fmt_error_9.f b/gcc/testsuite/gfortran.dg/fmt_error_9.f index 1d677509e37..40c73599ac8 100644 --- a/gcc/testsuite/gfortran.dg/fmt_error_9.f +++ b/gcc/testsuite/gfortran.dg/fmt_error_9.f @@ -16,7 +16,7 @@ write (line,str,iostat=istat, iomsg=msg) 1.0d0 if (istat.ne.0) STOP 3 read (*,str,iostat=istat, iomsg=msg) x - if (istat.ne.5006 .or. msg(1:15).ne."Positive width ") STOP 4 + if (istat.ne.5006 .or. msg(1:10).ne."Zero width") STOP 4 if (x.ne.555.25) STOP 5 write (line,'(1pd24.15e11.3)') 1.0d0, 1.234 diff --git a/gcc/testsuite/gfortran.dg/fmt_zero_width.f90 b/gcc/testsuite/gfortran.dg/fmt_zero_width.f90 new file mode 100644 index 00000000000..093c0a44c34 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fmt_zero_width.f90 @@ -0,0 +1,36 @@ +! { dg-do run } +! PR90374 "5.5 d0.d, e0.d, es0.d, en0.d, g0.d and ew.d edit descriptors +program pr90374 + real(4) :: rn + character(32) :: afmt, aresult + real(8) :: one = 1.0D0, zero = 0.0D0, nan, pinf, minf + + nan = zero/zero + rn = 0.00314_4 + afmt = "(D0.3)" + write (aresult,fmt=afmt) rn + if (aresult /= "0.314D-02") stop 12 + afmt = "(E0.10)" + write (aresult,fmt=afmt) rn + if (aresult /= "0.3139999928E-02") stop 15 + afmt = "(ES0.10)" + write (aresult,fmt=afmt) rn + if (aresult /= "3.1399999280E-03") stop 18 + afmt = "(EN0.10)" + write (aresult,fmt=afmt) rn + if (aresult /= "3.1399999280E-03") stop 21 + afmt = "(G0.10)" + write (aresult,fmt=afmt) rn + if (aresult /= "0.3139999928E-02") stop 24 + write (aresult,fmt="(D0.3)") rn + if (aresult /= "0.314D-02") stop 26 + write (aresult,fmt="(E0.10)") rn + if (aresult /= "0.3139999928E-02") stop 28 + write (aresult,fmt="(ES0.10)") rn + if (aresult /= "3.1399999280E-03") stop 30 + write (aresult,fmt="(EN0.10)") rn + if (aresult /= "3.1399999280E-03") stop 32 + write (aresult,fmt="(G0.10)") rn + if (aresult /= "0.3139999928E-02") stop 34 + +end diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index c2031cfdafd..0684c35b9b3 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,20 @@ +2019-11-06 Jerry DeLisle + + PR fortran/90374 + io/format.c (parse_format_list): Relax format checking for + zero width as default and when -std=f2018. + io/format.h (format_token): Move definition to io.h. + io/io.h (format_token): Add definition here to allow access to + this definition at higher levels. Rename the declaration of + write_real_g0 to write_real_w0 and add a new format_token + argument, allowing higher level functions to pass in the + token for handling of g0 vs the other zero width specifiers. + io/transfer.c (formatted_transfer_scalar_write): Add checks for + zero width and call write_real_w0 to handle it. + io/write.c (write_real_g0): Remove. + (write_real_w0): Add new, same as previous write_real_g0 except + check format token to handle the g0 case. + 2019-10-31 Tobias Burnus PR fortran/92284. diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c index e798d9bda87..b33620815d5 100644 --- a/libgfortran/io/format.c +++ b/libgfortran/io/format.c @@ -925,7 +925,7 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd) tail->repeat = repeat; u = format_lex (fmt); - if (t == FMT_G && u == FMT_ZERO) + if (u == FMT_ZERO) { *seen_dd = true; if (notification_std (GFC_STD_F2008) == NOTIFICATION_ERROR @@ -944,10 +944,8 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd) u = format_lex (fmt); if (u != FMT_POSINT) - { - fmt->error = posint_required; - goto finished; - } + notify_std (&dtp->common, GFC_STD_F2003, + "Positive width required"); tail->u.real.d = fmt->value; break; } diff --git a/libgfortran/io/format.h b/libgfortran/io/format.h index 84169e95d91..a0899736aea 100644 --- a/libgfortran/io/format.h +++ b/libgfortran/io/format.h @@ -27,22 +27,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "io.h" - -/* Format tokens. Only about half of these can be stored in the - format nodes. */ - -typedef enum -{ - FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD, - FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL, - FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING, - FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F, - FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC, - FMT_DP, FMT_STAR, FMT_RC, FMT_RD, FMT_RN, FMT_RP, FMT_RU, FMT_RZ, FMT_DT -} -format_token; - - /* Format nodes. A format string is converted into a tree of these structures, which is traversed as part of a data transfer statement. */ diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index bcd6dde9a5b..5b89d47e613 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -132,6 +132,20 @@ typedef struct format_hash_entry } format_hash_entry; +/* Format tokens. Only about half of these can be stored in the + format nodes. */ + +typedef enum +{ + FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD, + FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL, + FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING, + FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F, + FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC, + FMT_DP, FMT_STAR, FMT_RC, FMT_RD, FMT_RN, FMT_RP, FMT_RU, FMT_RZ, FMT_DT +} +format_token; + /* Representation of a namelist object in libgfortran Namelist Records @@ -928,8 +942,8 @@ internal_proto(write_o); extern void write_real (st_parameter_dt *, const char *, int); internal_proto(write_real); -extern void write_real_g0 (st_parameter_dt *, const char *, int, int); -internal_proto(write_real_g0); +extern void write_real_w0 (st_parameter_dt *, const char *, int, format_token, int); +internal_proto(write_real_w0); extern void write_x (st_parameter_dt *, int, int); internal_proto(write_x); diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 4c5e210ce5a..6382d0dad09 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -2008,7 +2008,10 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin goto need_data; if (require_type (dtp, BT_REAL, type, f)) return; - write_d (dtp, f, p, kind); + if (f->u.real.w == 0) + write_real_w0 (dtp, p, kind, FMT_D, f->u.real.d); + else + write_d (dtp, f, p, kind); break; case FMT_DT: @@ -2071,7 +2074,10 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin goto need_data; if (require_type (dtp, BT_REAL, type, f)) return; - write_e (dtp, f, p, kind); + if (f->u.real.w == 0) + write_real_w0 (dtp, p, kind, FMT_E, f->u.real.d); + else + write_e (dtp, f, p, kind); break; case FMT_EN: @@ -2079,7 +2085,10 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin goto need_data; if (require_type (dtp, BT_REAL, type, f)) return; - write_en (dtp, f, p, kind); + if (f->u.real.w == 0) + write_real_w0 (dtp, p, kind, FMT_EN, f->u.real.d); + else + write_en (dtp, f, p, kind); break; case FMT_ES: @@ -2087,7 +2096,10 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin goto need_data; if (require_type (dtp, BT_REAL, type, f)) return; - write_es (dtp, f, p, kind); + if (f->u.real.w == 0) + write_real_w0 (dtp, p, kind, FMT_ES, f->u.real.d); + else + write_es (dtp, f, p, kind); break; case FMT_F: @@ -2117,7 +2129,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin break; case BT_REAL: if (f->u.real.w == 0) - write_real_g0 (dtp, p, kind, f->u.real.d); + write_real_w0 (dtp, p, kind, FMT_G, f->u.real.d); else write_d (dtp, f, p, kind); break; diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index eacd1f79715..5ebe83b0dbd 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -1720,25 +1720,32 @@ write_real (st_parameter_dt *dtp, const char *source, int kind) compensate for the extra digit. */ void -write_real_g0 (st_parameter_dt *dtp, const char *source, int kind, int d) +write_real_w0 (st_parameter_dt *dtp, const char *source, int kind, + format_token fmt, int d) { fnode f; char buf_stack[BUF_STACK_SZ]; char str_buf[BUF_STACK_SZ]; char *buffer, *result; size_t buf_size, res_len, flt_str_len; - int comp_d; + int comp_d = 0; set_fnode_default (dtp, &f, kind); if (d > 0) f.u.real.d = d; + f.format = fmt; + + /* For FMT_G, Compensate for extra digits when using scale factor, d + is not specified, and the magnitude is such that E editing + is used. */ + if (fmt == FMT_G) + { + if (dtp->u.p.scale_factor > 0 && d == 0) + comp_d = 1; + else + comp_d = 0; + } - /* Compensate for extra digits when using scale factor, d is not - specified, and the magnitude is such that E editing is used. */ - if (dtp->u.p.scale_factor > 0 && d == 0) - comp_d = 1; - else - comp_d = 0; dtp->u.p.g0_no_blanks = 1; /* Precision for snprintf call. */ @@ -1750,7 +1757,7 @@ write_real_g0 (st_parameter_dt *dtp, const char *source, int kind, int d) buffer = select_buffer (dtp, &f, precision, buf_stack, &buf_size, kind); get_float_string (dtp, &f, source , kind, comp_d, buffer, - precision, buf_size, result, &flt_str_len); + precision, buf_size, result, &flt_str_len); write_float_string (dtp, result, flt_str_len); dtp->u.p.g0_no_blanks = 0; -- 2.30.2