aboutsummaryrefslogtreecommitdiff
path: root/libgfortran/io/transfer.c
diff options
context:
space:
mode:
authorJerry DeLisle <jvdelisle@gcc.gnu.org>2008-09-02 08:50:13 +0000
committerDaniel Kraft <domob@gcc.gnu.org>2008-09-02 10:50:13 +0200
commit900e887f6d2dd21c118f5de7cbcf3d56173a02a7 (patch)
tree317dab79bd42333332ad5ed9c18cf1fec7ff1af4 /libgfortran/io/transfer.c
parent52f4993488d2dd12d66dd99c2937e59319d0b1b6 (diff)
downloadgcc-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/io/transfer.c')
-rw-r--r--libgfortran/io/transfer.c7
1 files changed, 6 insertions, 1 deletions
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;