From 1060d9404d1ab275b540efe1c7868d08c07a81e1 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sat, 7 Feb 2015 15:13:15 +0000 Subject: re PR fortran/60956 (error reading (and writing) large text files in gfortran) 2015-02-07 Jerry DeLisle PR libgfortran/60956 * io/fbuf.c (fbuf_flush_list): New function that only flushes if current fbuf position exceeds a limit. * io/fbuf.h: Declare the new function. * io/io.h (enum unit_mode): Add two new modes. * io/list_read.c (list_formatted_read_scalar): Call new function. * io/write.c: Include fbuf.h. (list_formatted_write_scalar): Call new function. From-SVN: r220505 --- libgfortran/ChangeLog | 11 +++++++++++ libgfortran/io/fbuf.c | 36 ++++++++++++++++++++++++++++++++++++ libgfortran/io/fbuf.h | 3 +++ libgfortran/io/io.h | 2 +- libgfortran/io/list_read.c | 1 + libgfortran/io/write.c | 2 ++ 6 files changed, 54 insertions(+), 1 deletion(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index e228a67..d3b8f8f 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,14 @@ +2015-02-07 Jerry DeLisle + + PR libgfortran/60956 + * io/fbuf.c (fbuf_flush_list): New function that only flushes + if current fbuf position exceeds a limit. + * io/fbuf.h: Declare the new function. + * io/io.h (enum unit_mode): Add two new modes. + * io/list_read.c (list_formatted_read_scalar): Call new function. + * io/write.c: Include fbuf.h. (list_formatted_write_scalar): + Call new function. + 2015-01-24 Janne Blomqvist PR libfortran/64770 diff --git a/libgfortran/io/fbuf.c b/libgfortran/io/fbuf.c index 9a3a486..b3750d2 100644 --- a/libgfortran/io/fbuf.c +++ b/libgfortran/io/fbuf.c @@ -171,6 +171,42 @@ fbuf_flush (gfc_unit * u, unit_mode mode) } +/* The mode argument is LIST_WRITING for write mode and LIST_READING for + read. This should only be used for list directed I/O. + Return value is 0 for success, -1 on failure. */ + +int +fbuf_flush_list (gfc_unit * u, unit_mode mode) +{ + int nwritten; + + if (!u->fbuf) + return 0; + + if (u->fbuf->pos < 524288) /* Upper limit for list writing. */ + return 0; + + fbuf_debug (u, "fbuf_flush_list with mode %d: ", mode); + + if (mode == LIST_WRITING) + { + nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos); + if (nwritten < 0) + return -1; + } + + /* Salvage remaining bytes for both reading and writing. */ + if (u->fbuf->act > u->fbuf->pos) + memmove (u->fbuf->buf, u->fbuf->buf + u->fbuf->pos, + u->fbuf->act - u->fbuf->pos); + + u->fbuf->act -= u->fbuf->pos; + u->fbuf->pos = 0; + + return 0; +} + + int fbuf_seek (gfc_unit * u, int off, int whence) { diff --git a/libgfortran/io/fbuf.h b/libgfortran/io/fbuf.h index 902cd6e..220c8d7 100644 --- a/libgfortran/io/fbuf.h +++ b/libgfortran/io/fbuf.h @@ -59,6 +59,9 @@ internal_proto(fbuf_alloc); extern int fbuf_flush (gfc_unit *, unit_mode); internal_proto(fbuf_flush); +extern int fbuf_flush_list (gfc_unit *, unit_mode); +internal_proto(fbuf_flush_list); + extern int fbuf_seek (gfc_unit *, int, int); internal_proto(fbuf_seek); diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 928123b..f34d0c3 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -231,7 +231,7 @@ typedef enum unit_advance; typedef enum -{READING, WRITING} +{READING, WRITING, LIST_READING, LIST_WRITING} unit_mode; typedef enum diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 640774b..45243ed 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -2210,6 +2210,7 @@ cleanup: free_line (dtp); hit_eof (dtp); } + fbuf_flush_list (dtp->u.p.current_unit, LIST_READING); return err; } diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index 2149456..3e890b9 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -25,6 +25,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see . */ #include "io.h" +#include "fbuf.h" #include "format.h" #include "unix.h" #include @@ -1585,6 +1586,7 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, internal_error (&dtp->common, "list_formatted_write(): Bad type"); } + fbuf_flush_list (dtp->u.p.current_unit, LIST_WRITING); dtp->u.p.char_flag = (type == BT_CHARACTER); } -- cgit v1.1