From 09861cbee63a833e24b235a82432f2086f993624 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Wed, 18 Oct 2006 04:04:07 +0000 Subject: [PATCH] re PR fortran/29277 (Formated stream output: Translate "\n" / achar(10) into "\r\n" on some platforms) 2006-10-17 Jerry DeLisle PR libgfortran/29277 * io/list_read.c (next_char): Update strm_pos. (eat_separator): Delete extra call to unget_char. * io/transfer.c (read_block): Use read_sf for formatted stream I/O. (next_record_r): Update strm_pos for formatted stream I/O and handle end-of-record correctly. (next_record_w): Ditto. (next_record): Enable next record (r/w) functions and update strm_pos. (finalize_transfer): Call next_record to finish the record. From-SVN: r117846 --- libgfortran/ChangeLog | 12 ++++++++++ libgfortran/io/list_read.c | 8 +++---- libgfortran/io/transfer.c | 60 +++++++++++++++++++++++++++++----------------- 3 files changed, 54 insertions(+), 26 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 2852bbb..ff0e246 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,15 @@ +2006-10-17 Jerry DeLisle + + PR libgfortran/29277 + * io/list_read.c (next_char): Update strm_pos. + (eat_separator): Delete extra call to unget_char. + * io/transfer.c (read_block): Use read_sf for formatted stream I/O. + (next_record_r): Update strm_pos for formatted stream I/O and handle + end-of-record correctly. + (next_record_w): Ditto. + (next_record): Enable next record (r/w) functions and update strm_pos. + (finalize_transfer): Call next_record to finish the record. + 2006-10-13 Steven G. Kargl * m4/spacing.m4: Use scalbn[f,l] if ldexp[f,l] is unavailable. diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 0dcb3db..47ceb47 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -187,6 +187,9 @@ next_char (st_parameter_dt *dtp) length = 1; p = salloc_r (dtp->u.p.current_unit->s, &length); + + if (is_stream_io (dtp)) + dtp->u.p.current_unit->strm_pos++; if (is_internal_unit(dtp)) { @@ -294,10 +297,7 @@ eat_separator (st_parameter_dt *dtp) if (n == '\n') dtp->u.p.at_eol = 1; else - { - unget_char (dtp, n); - unget_char (dtp, c); - } + unget_char (dtp, n); break; case '\n': diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 663a1bf..b680d20 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -324,6 +324,13 @@ read_block (st_parameter_dt *dtp, int *length) return NULL; } + if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED) + { + source = read_sf (dtp, length, 0); + dtp->u.p.current_unit->strm_pos += + (gfc_offset) (*length + dtp->u.p.sf_seen_eor); + return source; + } nread = *length; source = salloc_r (dtp->u.p.current_unit->s, &nread); @@ -1921,8 +1928,7 @@ next_record_r (st_parameter_dt *dtp) switch (current_mode (dtp)) { - /* No records in STREAM I/O. */ - case FORMATTED_STREAM: + /* No records in unformatted STREAM I/O. */ case UNFORMATTED_STREAM: return; @@ -1970,6 +1976,7 @@ next_record_r (st_parameter_dt *dtp) } break; + case FORMATTED_STREAM: case FORMATTED_SEQUENTIAL: length = 1; /* sf_read has already terminated input because of an '\n' */ @@ -2019,6 +2026,9 @@ next_record_r (st_parameter_dt *dtp) dtp->u.p.current_unit->endfile = AT_ENDFILE; break; } + + if (is_stream_io (dtp)) + dtp->u.p.current_unit->strm_pos++; } while (*p != '\n'); @@ -2116,8 +2126,7 @@ next_record_w (st_parameter_dt *dtp, int done) switch (current_mode (dtp)) { - /* No records in STREAM I/O. */ - case FORMATTED_STREAM: + /* No records in unformatted STREAM I/O. */ case UNFORMATTED_STREAM: return; @@ -2168,6 +2177,7 @@ next_record_w (st_parameter_dt *dtp, int done) break; + case FORMATTED_STREAM: case FORMATTED_SEQUENTIAL: if (is_internal_unit (dtp)) @@ -2241,8 +2251,6 @@ next_record_w (st_parameter_dt *dtp, int done) } else { - if (dtp->u.p.current_unit->bytes_left == 0) - break; /* If this is the last call to next_record move to the farthest position reached in preparation for completing the record. @@ -2266,6 +2274,9 @@ next_record_w (st_parameter_dt *dtp, int done) #endif if (swrite (dtp->u.p.current_unit->s, &crlf[2-len], &len) != 0) goto io_error; + + if (is_stream_io (dtp)) + dtp->u.p.current_unit->strm_pos += len; } break; @@ -2284,9 +2295,6 @@ next_record_w (st_parameter_dt *dtp, int done) void next_record (st_parameter_dt *dtp, int done) { - if (is_stream_io (dtp)) - return; - gfc_offset fp; /* File position. */ dtp->u.p.current_unit->read_bad = 0; @@ -2296,18 +2304,22 @@ next_record (st_parameter_dt *dtp, int done) else next_record_w (dtp, done); - /* keep position up to date for INQUIRE */ - dtp->u.p.current_unit->flags.position = POSITION_ASIS; - dtp->u.p.current_unit->current_record = 0; - if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) - { - fp = file_position (dtp->u.p.current_unit->s); - /* Calculate next record, rounding up partial records. */ - dtp->u.p.current_unit->last_record = (fp + dtp->u.p.current_unit->recl - 1) - / dtp->u.p.current_unit->recl; - } - else - dtp->u.p.current_unit->last_record++; + if (!is_stream_io (dtp)) + { + /* keep position up to date for INQUIRE */ + dtp->u.p.current_unit->flags.position = POSITION_ASIS; + dtp->u.p.current_unit->current_record = 0; + if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) + { + fp = file_position (dtp->u.p.current_unit->s); + /* Calculate next record, rounding up partial records. */ + dtp->u.p.current_unit->last_record = + (fp + dtp->u.p.current_unit->recl - 1) / + dtp->u.p.current_unit->recl; + } + else + dtp->u.p.current_unit->last_record++; + } if (!done) pre_position (dtp); @@ -2373,7 +2385,11 @@ finalize_transfer (st_parameter_dt *dtp) next_record (dtp, 1); } else - flush (dtp->u.p.current_unit->s); + { + if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED) + next_record (dtp, 1); + flush (dtp->u.p.current_unit->s); + } sfree (dtp->u.p.current_unit->s); } -- 2.7.4