From 9355110f96f64237672a85f677f9876f979ab9bf Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sat, 7 Jun 2008 23:59:53 +0000 Subject: [PATCH] re PR fortran/36420 (Fortran 2008: g0 edit descriptor) 2008-06-07 Jerry DeLisle PR libfortran/36420 PR libfortran/36421 PR libfortran/36422 * io/io.h: Add prototype for write_real. * io/transfer.c (formatted_transfer_scalar): For FMT_G and width zero, use write_real. * io/format.c: Add zero width error message. (parse_format_list): Use error message for FMT_A if followed by FMT_ZERO. Use zero width error message for FMT_G if mode is READ or if -std=f95 or f2003. (fmormat0): Fix typo in comment. * io/write.c (write_a): Set wlen to len if FMT_G and length is zero. (write_l): Add wlen variable and use it if FMT_G and width is zero. (write_decimal): If FMT_G, set m to -1 to flag processor dependent formatting. (write_real): Remove static declaration. From-SVN: r136545 --- libgfortran/ChangeLog | 17 +++++++++++++++++ libgfortran/io/format.c | 23 ++++++++++++++++++++--- libgfortran/io/io.h | 3 +++ libgfortran/io/transfer.c | 5 ++++- libgfortran/io/write.c | 18 +++++++++++------- 5 files changed, 55 insertions(+), 11 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 9a25ecd5cee..dff8dc8a783 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,20 @@ +2008-06-07 Jerry DeLisle + + PR libfortran/36420 + PR libfortran/36421 + PR libfortran/36422 + * io/io.h: Add prototype for write_real. + * io/transfer.c (formatted_transfer_scalar): For FMT_G and width zero, + use write_real. + * io/format.c: Add zero width error message. (parse_format_list): Use + error message for FMT_A if followed by FMT_ZERO. Use zero width error + message for FMT_G if mode is READ or if -std=f95 or f2003. (fmormat0): + Fix typo in comment. + * io/write.c(write_a): Set wlen to len if FMT_G and length is zero. + (write_l): Add wlen variable and use it if FMT_G and width is zero. + (write_decimal): If FMT_G, set m to -1 to flag processor dependent + formatting. (write_real): Remove static declaration. + 2008-05-28 Francois-Xavier Coudert PR fortran/36319 diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c index 734b633de06..cf299c161a4 100644 --- a/libgfortran/io/format.c +++ b/libgfortran/io/format.c @@ -71,8 +71,8 @@ static const char posint_required[] = "Positive width required in format", unexpected_end[] = "Unexpected end of format string", bad_string[] = "Unterminated character constant in format", bad_hollerith[] = "Hollerith constant extends past the end of the format", - reversion_error[] = "Exhausted data descriptors in format"; - + reversion_error[] = "Exhausted data descriptors in format", + zero_width[] = "Zero width in format descriptor"; /* next_char()-- Return the next character in the format string. * Returns -1 when the string is done. If the literal flag is set, @@ -698,6 +698,12 @@ parse_format_list (st_parameter_dt *dtp) case FMT_A: t = format_lex (fmt); + if (t == FMT_ZERO) + { + fmt->error = zero_width; + goto finished; + } + if (t != FMT_POSINT) { fmt->saved_token = t; @@ -719,6 +725,17 @@ parse_format_list (st_parameter_dt *dtp) tail->repeat = repeat; u = format_lex (fmt); + if (t == FMT_G && u == FMT_ZERO) + { + if (notification_std (GFC_STD_F2008) == ERROR + || dtp->u.p.mode == READING) + { + fmt->error = zero_width; + goto finished; + } + tail->u.real.w = 0; + break; + } if (t == FMT_F || dtp->u.p.mode == WRITING) { if (u != FMT_POSINT && u != FMT_ZERO) @@ -1079,7 +1096,7 @@ next_format0 (fnode * f) /* next_format()-- Return the next format node. If the format list * ends up being exhausted, we do reversion. Reversion is only - * allowed if the we've seen a data descriptor since the + * allowed if we've seen a data descriptor since the * initialization or the last reversion. We return NULL if there * are no more data descriptors to return (which is an error * condition). */ diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 7f9f38f80c0..ea75bdbc405 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -931,6 +931,9 @@ internal_proto(write_l); extern void write_o (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_o); +extern void write_real (st_parameter_dt *, const char *, int); +internal_proto(write_real); + 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 ff7e651016e..36181f6fc05 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1175,7 +1175,10 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len, write_a (dtp, f, p, len); break; case BT_REAL: - write_d (dtp, f, p, len); + if (f->u.real.w == 0) + write_real (dtp, p, len); + else + write_d (dtp, f, p, len); break; default: bad_type: diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index ea8ad94b8ca..6135d60fe5d 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -46,7 +46,9 @@ write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len) int wlen; char *p; - wlen = f->u.string.length < 0 ? len : f->u.string.length; + wlen = f->u.string.length < 0 + || (f->format == FMT_G && f->u.string.length == 0) + ? len : f->u.string.length; #ifdef HAVE_CRLF /* If this is formatted STREAM IO convert any embedded line feed characters @@ -235,15 +237,18 @@ void write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len) { char *p; + int wlen; GFC_INTEGER_LARGEST n; - p = write_block (dtp, f->u.w); + wlen = (f->format == FMT_G && f->u.w == 0) ? 1 : f->u.w; + + p = write_block (dtp, wlen); if (p == NULL) return; - memset (p, ' ', f->u.w - 1); + memset (p, ' ', wlen - 1); n = extract_int (source, len); - p[f->u.w - 1] = (n) ? 'T' : 'F'; + p[wlen - 1] = (n) ? 'T' : 'F'; } @@ -340,12 +345,11 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source, char itoa_buf[GFC_BTOA_BUF_SIZE]; w = f->u.integer.w; - m = f->u.integer.m; + m = f->format == FMT_G ? -1 : f->u.integer.m; n = extract_int (source, len); /* Special case: */ - if (m == 0 && n == 0) { if (w == 0) @@ -690,7 +694,7 @@ write_character (st_parameter_dt *dtp, const char *source, int length) This is 1PG14.7E2 for REAL(4), 1PG23.15E3 for REAL(8), 1PG28.19E4 for REAL(10) and 1PG43.34E4 for REAL(16). */ -static void +void write_real (st_parameter_dt *dtp, const char *source, int length) { fnode f ; -- 2.30.2