From 50220190d24a251bba53c1eb6cf54ae6979d38b6 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sun, 21 Dec 2008 21:23:52 +0000 Subject: [PATCH] re PR fortran/38398 (g0.w edit descriptor: Update for F2008 Tokyo meeting changes) 2008-12-21 Jerry DeLisle PR libfortran/38398 * io/io.h (st_parameter_dt): Add new bit to keep track of when to suppress blanks for g0 formatting. * io/transfer.c (formatted_transfer_scalar): Always call write_real_g0 for g0 formatting. * io.c (write.c): Do not use ES formatting and use new bit to suppress blanks. * io/write_float.def (output_float): Adjust the location of setting the width so that it can be adjusted when suppressing blanks. Set number of blanks to zero when dtp->u.p.g0_no_blanks is set. Do some minor code clean-up and add some white space for readability. From-SVN: r142871 --- libgfortran/ChangeLog | 14 ++++++++++++++ libgfortran/io/io.h | 4 +++- libgfortran/io/transfer.c | 7 +------ libgfortran/io/write.c | 9 ++++----- libgfortran/io/write_float.def | 31 ++++++++++++++++++++----------- 5 files changed, 42 insertions(+), 23 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 688060278fea..f60c5d0e8def 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,17 @@ +2008-12-21 Jerry DeLisle + + PR libfortran/38398 + * io/io.h (st_parameter_dt): Add new bit to keep track of when to + suppress blanks for g0 formatting. + * io/transfer.c (formatted_transfer_scalar): Always call write_real_g0 + for g0 formatting. + * io.c (write.c): Do not use ES formatting and use new bit to suppress + blanks. + * io/write_float.def (output_float): Adjust the location of setting the + width so that it can be adjusted when suppressing blanks. Set number of + blanks to zero when dtp->u.p.g0_no_blanks is set. Do some minor code + clean-up and add some white space for readability. + 2008-12-18 Ralf Wildenhues * configure: Regenerate. diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 1f3639148665..1993158ef589 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -444,7 +444,9 @@ typedef struct st_parameter_dt /* An internal unit specific flag to signify an EOF condition for list directed read. */ unsigned at_eof : 1; - /* 16 unused bits. */ + /* Used for g0 floating point output. */ + unsigned g0_no_blanks : 1; + /* 15 unused bits. */ char last_char; char nml_delim; diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index ea63a0daffca..d50641bcce59 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1221,12 +1221,7 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, break; case BT_REAL: if (f->u.real.w == 0) - { - if (f->u.real.d == 0) - write_real (dtp, p, kind); - else - write_real_g0 (dtp, p, kind, f->u.real.d); - } + write_real_g0 (dtp, p, kind, 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 3cd67b39ba79..e3d38e638e80 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -1010,13 +1010,12 @@ void write_real_g0 (st_parameter_dt *dtp, const char *source, int length, int d) { fnode f ; - int org_scale = dtp->u.p.scale_factor; - dtp->u.p.scale_factor = 1; set_fnode_default (dtp, &f, length); - f.format = FMT_ES; - f.u.real.d = d; + if (d > 0) + f.u.real.d = d; + dtp->u.p.g0_no_blanks = 1; write_float (dtp, &f, source , length); - dtp->u.p.scale_factor = org_scale; + dtp->u.p.g0_no_blanks = 0; } diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def index d8799f2ae03e..a5d292ca76cd 100644 --- a/libgfortran/io/write_float.def +++ b/libgfortran/io/write_float.def @@ -333,15 +333,6 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, else edigits = 0; - /* Pick a field size if none was specified. */ - if (w <= 0) - w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1); - - /* Create the ouput buffer. */ - out = write_block (dtp, w); - if (out == NULL) - return; - /* Zero values always output as positive, even if the value was negative before rounding. */ for (i = 0; i < ndigits; i++) @@ -359,11 +350,26 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, sign = calculate_sign (dtp, 0); } + /* Pick a field size if none was specified. */ + if (w <= 0) + w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1); + /* Work out how much padding is needed. */ nblanks = w - (nbefore + nzero + nafter + edigits + 1); if (sign != S_NONE) nblanks--; + if (dtp->u.p.g0_no_blanks) + { + w -= nblanks; + nblanks = 0; + } + + /* Create the ouput buffer. */ + out = write_block (dtp, w); + if (out == NULL) + return; + /* Check the value fits in the specified field width. */ if (nblanks < 0 || edigits == -1) { @@ -419,6 +425,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, digits += i; out += nbefore; } + /* Output the decimal point. */ *(out++) = dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? '.' : ','; @@ -461,12 +468,14 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, #endif memcpy (out, buffer, edigits); } + if (dtp->u.p.no_leading_blank) { out += edigits; memset( out , ' ' , nblanks ); dtp->u.p.no_leading_blank = 0; } + #undef STR #undef STR1 #undef MIN_FIELD_WIDTH @@ -606,7 +615,7 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \ int save_scale_factor, nb = 0;\ \ save_scale_factor = dtp->u.p.scale_factor;\ - newf = get_mem (sizeof (fnode));\ + newf = (fnode *) get_mem (sizeof (fnode));\ \ exp_d = calculate_exp_ ## x (d);\ if ((m > 0.0 && m < 0.1 - 0.05 / exp_d) || (m >= exp_d - 0.5 ) ||\ @@ -680,7 +689,7 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \ \ free_mem(newf);\ \ - if (nb > 0)\ + if (nb > 0 && !dtp->u.p.g0_no_blanks)\ { \ p = write_block (dtp, nb);\ if (p == NULL)\