diff options
author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2008-09-02 08:50:13 +0000 |
---|---|---|
committer | Daniel Kraft <domob@gcc.gnu.org> | 2008-09-02 10:50:13 +0200 |
commit | 900e887f6d2dd21c118f5de7cbcf3d56173a02a7 (patch) | |
tree | 317dab79bd42333332ad5ed9c18cf1fec7ff1af4 /libgfortran | |
parent | 52f4993488d2dd12d66dd99c2937e59319d0b1b6 (diff) | |
download | gcc-900e887f6d2dd21c118f5de7cbcf3d56173a02a7.zip gcc-900e887f6d2dd21c118f5de7cbcf3d56173a02a7.tar.gz gcc-900e887f6d2dd21c118f5de7cbcf3d56173a02a7.tar.bz2 |
re PR fortran/37228 (F2008: Support g0.<d> edit descriptor)
2008-09-01 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/37228
* io.c (check_format): Allow specifying precision with g0 format.
2008-09-01 Jerry DeLisle <jvdelisle@gcc.gnu.org>
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 <jvdelisle@gcc.gnu.org>
PR fortran/37228
* gfortran.dg/fmt_g0_4.f08: Revised test.
From-SVN: r139886
Diffstat (limited to 'libgfortran')
-rw-r--r-- | libgfortran/ChangeLog | 14 | ||||
-rw-r--r-- | libgfortran/io/format.c | 14 | ||||
-rw-r--r-- | libgfortran/io/io.h | 3 | ||||
-rw-r--r-- | libgfortran/io/transfer.c | 7 | ||||
-rw-r--r-- | libgfortran/io/write.c | 65 |
5 files changed, 80 insertions, 23 deletions
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 <jvdelisle@gcc.gnu.org> + 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 <jvdelisle@gcc.gnu.org> + * runtime/error.c: Fix cast for printf. 2008-08-30 Jerry DeLisle <jvdelisle@gcc.gnu.org> 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; } |