* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@107563
138bc75d-0d04-0410-961f-
82ee72b054a4
+2005-11-27 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ 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 <echristo@apple.com>
* gcc.dg/intmax_t-1.c: Remove mips xfail.
! { 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
! { 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
+2005-11-27 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ 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 <rth@redhat.com>
* io/list_read.c (nml_parse_qualifier): Use ssize_t instead of int
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;
static void
eat_separator (st_parameter_dt *dtp)
{
- char c;
+ char c, n;
eat_spaces (dtp);
dtp->u.p.comma_flag = 0;
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;
else
{
c = eat_spaces (dtp);
- if (c == '\n')
+ if (c == '\n' || c == '\r')
goto restart;
}
goto done;
}
- if (c != '\n')
+ if (c != '\n' && c != '\r')
push_char (dtp, c);
break;
/* "&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. */
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);
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. */
}
*length = n;
- dtp->u.p.sf_seen_eor = 1;
+ dtp->u.p.sf_seen_eor = (crlf ? 2 : 1);
break;
}
/* 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)
{
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
/* rwflag |= O_LARGEFILE; */
-#ifdef HAVE_CRLF
+#if defined(HAVE_CRLF) && defined(O_BINARY)
crflag |= O_BINARY;
#endif
}
-/* 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
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)
{
if (num > 5)
{
num = 0;
+#ifdef HAVE_CRLF
+ write_character (dtp, "\r\n ", 3);
+#else
write_character (dtp, "\n ", 2);
+#endif
}
rep_ctr = 1;
}
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. */