From 67732fbced89c42dabea4a3bc160da80d0db046a Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Thu, 7 Nov 2019 03:06:20 +0000 Subject: 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 --- 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 ++++++++++++++++--------- 6 files changed, 69 insertions(+), 37 deletions(-) (limited to 'libgfortran') diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index c2031cf..0684c35 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 e798d9b..b336208 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 84169e9..a089973 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 bcd6dde..5b89d47 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 4c5e210..6382d0d 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 eacd1f7..5ebe83b 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; -- cgit v1.1