From 900e887f6d2dd21c118f5de7cbcf3d56173a02a7 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Tue, 2 Sep 2008 08:50:13 +0000 Subject: [PATCH] re PR fortran/37228 (F2008: Support g0. edit descriptor) 2008-09-01 Jerry DeLisle PR fortran/37228 * io.c (check_format): Allow specifying precision with g0 format. 2008-09-01 Jerry DeLisle PR libfortran/37301 PR libfortran/37228 * io/io.h (write_real_g0): Declare new function to handle g0.d format. * io/transfer.c (formatted_transfer_scalar): Use new function. * io/format.c (parse_format_list): Enable g0.d. * io/write.c (write_a_char4): Delete unused var. (set_fnode_default): New function to set the default fnode w, d, and e factored from write_real. (write_real): Use new factored function. (write_real_g0): New function that sets d to that passed by g0.d format specifier and set format to ES. Default values for w and e are used from the new function, set_fnode_default. 2008-09-01 Jerry DeLisle PR fortran/37228 * gfortran.dg/fmt_g0_4.f08: Revised test. From-SVN: r139886 --- gcc/fortran/ChangeLog | 5 +++ gcc/fortran/io.c | 25 ++++++------- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/fmt_g0_4.f08 | 12 ++++++- libgfortran/ChangeLog | 14 ++++++++ libgfortran/io/format.c | 14 ++++++++ libgfortran/io/io.h | 3 ++ libgfortran/io/transfer.c | 7 +++- libgfortran/io/write.c | 65 ++++++++++++++++++++++------------ 9 files changed, 112 insertions(+), 38 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a878f0b..213af61 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2008-09-01 Jerry DeLisle + + PR fortran/37228 + * io.c (check_format): Allow specifying precision with g0 format. + 2008-09-02 Daniel Kraft * gfortran.h (struct gfc_namespace): New member `implicit_loc'. diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 979dfc2..298c758 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -483,7 +483,6 @@ check_format (bool is_input) " at %L"); const char *unexpected_end = _("Unexpected end of format string"); const char *zero_width = _("Zero width in format descriptor"); - const char *g0_precision = _("Specifying precision with G0 not allowed"); const char *error; format_token t, u; @@ -701,27 +700,25 @@ data_desc: error = zero_width; goto syntax; } - if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: 'G0' in " "format at %C") == FAILURE) return FAILURE; + u = format_lex (); + if (u != FMT_PERIOD) + { + saved_token = u; + break; + } u = format_lex (); - if (u == FMT_PERIOD) + if (u == FMT_ERROR) + goto fail; + if (u != FMT_POSINT) { - error = g0_precision; + error = posint_required; goto syntax; } - saved_token = u; - goto between_desc; - } - - if (u == FMT_ERROR) - goto fail; - if (u != FMT_POSINT) - { - error = posint_required; - goto syntax; + break; } u = format_lex (); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5557733..83d310f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-09-01 Jerry DeLisle + + PR fortran/37228 + * gfortran.dg/fmt_g0_4.f08: Revised test. + 2008-09-02 Daniel Kraft * gfortran.dg/abstract_type_1.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/fmt_g0_4.f08 b/gcc/testsuite/gfortran.dg/fmt_g0_4.f08 index 149b1aa..500117e 100644 --- a/gcc/testsuite/gfortran.dg/fmt_g0_4.f08 +++ b/gcc/testsuite/gfortran.dg/fmt_g0_4.f08 @@ -1,5 +1,15 @@ ! { dg-do compile } ! { dg-options "-std=f2008" } ! PR36725 Compile time error for g0 edit descriptor -print '(g0.9)', 0.1 ! { dg-error "Specifying precision" } +character(30) :: line +write(line, '(g0.3)') 0.1 +if (line.ne." 1.000E-01") call abort +write(line, '(g0.9)') 1.0 +if (line.ne."1.000000000E+00") call abort +write(line, '(g0.5)') 29.23 +if (line.ne." 2.92300E+01") call abort +write(line, '(g0.8)') -28.4 +if (line.ne."-2.83999996E+01") call abort +write(line, '(g0.8)') -0.0001 +if (line.ne."-9.99999975E-05") call abort end diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 8670d46..1e65eb1 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,5 +1,19 @@ 2008-09-01 Jerry DeLisle + PR libfortran/37301 + PR libfortran/37228 + * io/io.h (write_real_g0): Declare new function to handle g0.d format. + * io/transfer.c (formatted_transfer_scalar): Use new function. + * io/format.c (parse_format_list): Enable g0.d. + * io/write.c (write_a_char4): Delete unused var. + (set_fnode_default): New function to set the default fnode w, d, and e + factored from write_real. (write_real): Use new factored function. + (write_real_g0): New function that sets d to that passed by g0.d format + specifier and set format to ES. Default values for w and e are used + from the new function, set_fnode_default. + +2008-09-01 Jerry DeLisle + * runtime/error.c: Fix cast for printf. 2008-08-30 Jerry DeLisle diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c index 02ce291..667797f 100644 --- a/libgfortran/io/format.c +++ b/libgfortran/io/format.c @@ -735,6 +735,20 @@ parse_format_list (st_parameter_dt *dtp) goto finished; } tail->u.real.w = 0; + u = format_lex (fmt); + if (u != FMT_PERIOD) + { + fmt->saved_token = u; + break; + } + + u = format_lex (fmt); + if (u != FMT_POSINT) + { + fmt->error = posint_required; + goto finished; + } + tail->u.real.d = fmt->value; break; } if (t == FMT_F || dtp->u.p.mode == WRITING) diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index cb7147d..228372a 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -940,6 +940,9 @@ 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_x (st_parameter_dt *, int, int); internal_proto(write_x); diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index fd63139..c810f4d 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1213,7 +1213,12 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, break; case BT_REAL: if (f->u.real.w == 0) - write_real (dtp, p, kind); + { + if (f->u.real.d == 0) + write_real (dtp, p, kind); + else + 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 65210bc..414a69e 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -301,7 +301,7 @@ write_a_char4 (st_parameter_dt *dtp, const fnode *f, const char *source, int len if (is_stream_io (dtp)) { const char crlf[] = "\r\n"; - int i, j, bytes; + int i, bytes; gfc_char4_t *qq; bytes = 0; @@ -952,43 +952,64 @@ write_character (st_parameter_dt *dtp, const char *source, int kind, int length) } -/* Output a real number with default format. - This is 1PG14.7E2 for REAL(4), 1PG23.15E3 for REAL(8), - 1PG28.19E4 for REAL(10) and 1PG43.34E4 for REAL(16). */ +/* Set an fnode to default format. */ -void -write_real (st_parameter_dt *dtp, const char *source, int length) +static void +set_fnode_default (st_parameter_dt *dtp, fnode *f, int length) { - fnode f ; - int org_scale = dtp->u.p.scale_factor; - f.format = FMT_G; - dtp->u.p.scale_factor = 1; + f->format = FMT_G; switch (length) { case 4: - f.u.real.w = 15; - f.u.real.d = 8; - f.u.real.e = 2; + f->u.real.w = 15; + f->u.real.d = 8; + f->u.real.e = 2; break; case 8: - f.u.real.w = 25; - f.u.real.d = 17; - f.u.real.e = 3; + f->u.real.w = 25; + f->u.real.d = 17; + f->u.real.e = 3; break; case 10: - f.u.real.w = 29; - f.u.real.d = 20; - f.u.real.e = 4; + f->u.real.w = 29; + f->u.real.d = 20; + f->u.real.e = 4; break; case 16: - f.u.real.w = 44; - f.u.real.d = 35; - f.u.real.e = 4; + f->u.real.w = 44; + f->u.real.d = 35; + f->u.real.e = 4; break; default: internal_error (&dtp->common, "bad real kind"); break; } +} +/* Output a real number with default format. + This is 1PG14.7E2 for REAL(4), 1PG23.15E3 for REAL(8), + 1PG28.19E4 for REAL(10) and 1PG43.34E4 for REAL(16). */ + +void +write_real (st_parameter_dt *dtp, const char *source, int length) +{ + fnode f ; + int org_scale = dtp->u.p.scale_factor; + dtp->u.p.scale_factor = 1; + set_fnode_default (dtp, &f, length); + write_float (dtp, &f, source , length); + dtp->u.p.scale_factor = org_scale; +} + + +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; write_float (dtp, &f, source , length); dtp->u.p.scale_factor = org_scale; } -- 2.7.4