From: Francois-Xavier Coudert Date: Sun, 27 Nov 2005 11:42:46 +0000 (+0100) Subject: re PR libfortran/24919 ([4.0] CRLF support in libgfortran) X-Git-Tag: releases/gcc-4.2.0~5730 X-Git-Url: https://gcc.gnu.org/git/?a=commitdiff_plain;h=8824fd4cc119ccbeaab451122d5cbff6971bf958;p=gcc.git re PR libfortran/24919 ([4.0] CRLF support in libgfortran) PR libfortran/24919 * io/list_read.c (eat_separator, finish_separator, read_character): Handle CRLF separators correctly during reads. (nml_query): Use the HAVE_CRLF macro to print adequate newlines. * io/io.h (st_parameter_dt): Add comment about the possible values for sf_seen_eor. * io/unix.c (tempfile, regular_file): HAVE_CRLF doesn't imply that O_BINARY is defined, so we add that condition. (stream_at_bof): Fix typo in comment. * io/transfer.c (read_sf): Handle correctly CRLF, setting sf_seen_eor value to 2 instead of 1. (formatted_transfer_scalar): Use the sf_seen_eor value to handle CRLF the right way. * io/write.c (nml_write_obj, namelist_write): Use CRLF as newline when HAVE_CRLF is defined. * gfortran.dg/ftell_1.f90: Modify testcase so that it doesn't fail on CRLF platforms. * gfortran.dg/ftell_2.f90: Likewise. From-SVN: r107563 --- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4ce34eb5468c..66bf1af2106b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2005-11-27 Francois-Xavier Coudert + + PR libfortran/24919 + * gfortran.dg/ftell_1.f90: Modify testcase so that it doesn't + fail on CRLF platforms. + * gfortran.dg/ftell_2.f90: Likewise. + 2005-11-26 Eric Christopher * gcc.dg/intmax_t-1.c: Remove mips xfail. diff --git a/gcc/testsuite/gfortran.dg/ftell_1.f90 b/gcc/testsuite/gfortran.dg/ftell_1.f90 index bd154f1fca4b..eb09caf70542 100644 --- a/gcc/testsuite/gfortran.dg/ftell_1.f90 +++ b/gcc/testsuite/gfortran.dg/ftell_1.f90 @@ -1,12 +1,15 @@ ! { dg-do run } - integer*8 o + integer*8 o, o2 open (10, status="scratch") call ftell (10, o) if (o /= 0) call abort write (10,"(A)") "1234567" call ftell (10, o) - if (o /= 8) call abort + if (o /= 8 .and. o /= 9) call abort + write (10,"(A)") "1234567" + call ftell (10, o2) + if (o2 /= 2 * o) call abort close (10) call ftell (10, o) if (o /= -1) call abort diff --git a/gcc/testsuite/gfortran.dg/ftell_2.f90 b/gcc/testsuite/gfortran.dg/ftell_2.f90 index 1dda1fbfd789..a6fc1c19682d 100644 --- a/gcc/testsuite/gfortran.dg/ftell_2.f90 +++ b/gcc/testsuite/gfortran.dg/ftell_2.f90 @@ -1,8 +1,12 @@ ! { dg-do run } + integer*8 o open (10, status="scratch") if (ftell(10) /= 0) call abort write (10,"(A)") "1234567" - if (ftell(10) /= 8) call abort + if (ftell(10) /= 8 .and. ftell(10) /= 9) call abort + o = ftell(10) + write (10,"(A)") "1234567" + if (ftell(10) /= 2 * o) call abort close (10) if (ftell(10) /= -1) call abort end diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index d0bae6e2c90b..109e090e501f 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,21 @@ +2005-11-27 Francois-Xavier Coudert + + PR libfortran/24919 + * io/list_read.c (eat_separator, finish_separator, + read_character): Handle CRLF separators correctly during reads. + (nml_query): Use the HAVE_CRLF macro to print adequate newlines. + * io/io.h (st_parameter_dt): Add comment about the possible + values for sf_seen_eor. + * io/unix.c (tempfile, regular_file): HAVE_CRLF doesn't imply + that O_BINARY is defined, so we add that condition. + (stream_at_bof): Fix typo in comment. + * io/transfer.c (read_sf): Handle correctly CRLF, setting + sf_seen_eor value to 2 instead of 1. + (formatted_transfer_scalar): Use the sf_seen_eor value to + handle CRLF the right way. + * io/write.c (nml_write_obj, namelist_write): Use CRLF as newline + when HAVE_CRLF is defined. + 2005-11-26 Richard Henderson * io/list_read.c (nml_parse_qualifier): Use ssize_t instead of int diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index e0b251a5a82b..48cc2a19ab20 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -379,12 +379,16 @@ typedef struct st_parameter_dt int skips; /* Number of spaces to be done for T and X-editing. */ int pending_spaces; + /* Whether an EOR condition was encountered. Value is: + 0 if no EOR was encountered + 1 if an EOR was encountered due to a 1-byte marker (LF) + 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */ + int sf_seen_eor; unit_advance advance_status; unsigned reversion_flag : 1; /* Format reversion has occurred. */ unsigned first_item : 1; unsigned seen_dollar : 1; - unsigned sf_seen_eor : 1; unsigned eor_condition : 1; unsigned no_leading_blank : 1; unsigned char_flag : 1; diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 939c4a10683c..3988e3f00d87 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -201,7 +201,7 @@ eat_spaces (st_parameter_dt *dtp) static void eat_separator (st_parameter_dt *dtp) { - char c; + char c, n; eat_spaces (dtp); dtp->u.p.comma_flag = 0; @@ -218,8 +218,18 @@ eat_separator (st_parameter_dt *dtp) dtp->u.p.input_complete = 1; break; - case '\n': case '\r': + n = next_char(dtp); + if (n == '\n') + dtp->u.p.at_eol = 1; + else + { + unget_char (dtp, n); + unget_char (dtp, c); + } + break; + + case '\n': dtp->u.p.at_eol = 1; break; @@ -263,7 +273,7 @@ finish_separator (st_parameter_dt *dtp) else { c = eat_spaces (dtp); - if (c == '\n') + if (c == '\n' || c == '\r') goto restart; } @@ -796,7 +806,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused))) goto done; } - if (c != '\n') + if (c != '\n' && c != '\r') push_char (dtp, c); break; @@ -1741,32 +1751,56 @@ nml_query (st_parameter_dt *dtp, char c) /* "&namelist_name\n" */ len = dtp->namelist_name_len; +#ifdef HAVE_CRLF + p = write_block (dtp, len + 3); +#else p = write_block (dtp, len + 2); +#endif if (!p) goto query_return; memcpy (p, "&", 1); memcpy ((char*)(p + 1), dtp->namelist_name, len); +#ifdef HAVE_CRLF + memcpy ((char*)(p + len + 1), "\r\n", 2); +#else memcpy ((char*)(p + len + 1), "\n", 1); +#endif for (nl = dtp->u.p.ionml; nl; nl = nl->next) { /* " var_name\n" */ len = strlen (nl->var_name); +#ifdef HAVE_CRLF + p = write_block (dtp, len + 3); +#else p = write_block (dtp, len + 2); +#endif if (!p) goto query_return; memcpy (p, " ", 1); memcpy ((char*)(p + 1), nl->var_name, len); +#ifdef HAVE_CRLF + memcpy ((char*)(p + len + 1), "\r\n", 2); +#else memcpy ((char*)(p + len + 1), "\n", 1); +#endif } /* "&end\n" */ +#ifdef HAVE_CRLF + p = write_block (dtp, 6); +#else p = write_block (dtp, 5); +#endif if (!p) goto query_return; +#ifdef HAVE_CRLF + memcpy (p, "&end\r\n", 6); +#else memcpy (p, "&end\n", 5); +#endif } /* Flush the stream to force immediate output. */ diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index a4ea81c1b032..44cf27ec65af 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -136,7 +136,8 @@ static char * read_sf (st_parameter_dt *dtp, int *length) { char *base, *p, *q; - int n, readlen; + int n, readlen, crlf; + gfc_offset pos; if (*length > SCRATCH_SIZE) dtp->u.p.line_buffer = get_mem (*length); @@ -183,6 +184,19 @@ read_sf (st_parameter_dt *dtp, int *length) if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar) dtp->u.p.eor_condition = 1; + crlf = 0; + /* If we encounter a CR, it might be a CRLF. */ + if (*q == '\r') /* Probably a CRLF */ + { + readlen = 1; + pos = stream_offset (dtp->u.p.current_unit->s); + q = salloc_r (dtp->u.p.current_unit->s, &readlen); + if (*q != '\n' && readlen == 1) /* Not a CRLF after all. */ + sseek (dtp->u.p.current_unit->s, pos); + else + crlf = 1; + } + /* Without padding, terminate the I/O statement without assigning the value. With padding, the value still needs to be assigned, so we can just continue with a short read. */ @@ -193,7 +207,7 @@ read_sf (st_parameter_dt *dtp, int *length) } *length = n; - dtp->u.p.sf_seen_eor = 1; + dtp->u.p.sf_seen_eor = (crlf ? 2 : 1); break; } @@ -803,10 +817,20 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len, /* Adjust everything for end-of-record condition */ if (dtp->u.p.sf_seen_eor && !is_internal_unit (dtp)) { - dtp->u.p.current_unit->bytes_left--; + if (dtp->u.p.sf_seen_eor == 2) + { + /* The EOR was a CRLF (two bytes wide). */ + dtp->u.p.current_unit->bytes_left -= 2; + dtp->u.p.skips -= 2; + } + else + { + /* The EOR marker was only one byte wide. */ + dtp->u.p.current_unit->bytes_left--; + dtp->u.p.skips--; + } bytes_used = pos; dtp->u.p.sf_seen_eor = 0; - dtp->u.p.skips--; } if (dtp->u.p.skips < 0) { diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c index d1833f37e2db..6750b6f61420 100644 --- a/libgfortran/io/unix.c +++ b/libgfortran/io/unix.c @@ -1037,7 +1037,7 @@ tempfile (st_parameter_open *opp) if (mktemp (template)) do -#ifdef HAVE_CRLF +#if defined(HAVE_CRLF) && defined(O_BINARY) fd = open (template, O_RDWR | O_CREAT | O_EXCL | O_BINARY, S_IREAD | S_IWRITE); #else @@ -1127,7 +1127,7 @@ regular_file (st_parameter_open *opp, unit_flags *flags) /* rwflag |= O_LARGEFILE; */ -#ifdef HAVE_CRLF +#if defined(HAVE_CRLF) && defined(O_BINARY) crflag |= O_BINARY; #endif @@ -1475,7 +1475,7 @@ stream_at_bof (stream * s) } -/* stream_at_eof()-- Returns nonzero if the stream is at the beginning +/* stream_at_eof()-- Returns nonzero if the stream is at the end * of the file. */ int diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index fb91639d2ac2..8ae2c131955c 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -1536,7 +1536,11 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, if (obj->type != GFC_DTYPE_DERIVED) { +#ifdef HAVE_CRLF + write_character (dtp, "\r\n ", 3); +#else write_character (dtp, "\n ", 2); +#endif len = 0; if (base) { @@ -1728,7 +1732,11 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, if (num > 5) { num = 0; +#ifdef HAVE_CRLF + write_character (dtp, "\r\n ", 3); +#else write_character (dtp, "\n ", 2); +#endif } rep_ctr = 1; } @@ -1808,7 +1816,11 @@ namelist_write (st_parameter_dt *dtp) t1 = nml_write_obj (dtp, t2, dummy_offset, dummy, dummy_name); } } +#ifdef HAVE_CRLF + write_character (dtp, " /\r\n ", 5); +#else write_character (dtp, " /\n", 4); +#endif /* Recover the original delimiter. */