diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4ce34eb5468c910533d966ab07f692d93b352305..66bf1af2106b918c89502ea837dc38408d6e88cc 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+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.
diff --git a/gcc/testsuite/gfortran.dg/ftell_1.f90 b/gcc/testsuite/gfortran.dg/ftell_1.f90
index bd154f1fca4b2e98dbaac16e80dfb54e383caee4..eb09caf70542dafee45a2acbc4f83c1506cad505 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 1dda1fbfd789b3996a5961e66911eedfd63c11c8..a6fc1c19682d6e98af00373613a0abad2d31d337 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 d0bae6e2c90b45257eebbe56263d0535a0dc6f36..109e090e501f40d98bbcfff8b83847c803601ecb 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,21 @@
+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
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index e0b251a5a82bcbccd028121a63fcb4749ddecbbc..48cc2a19ab208914bdffafdad25b19587b499407 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 939c4a10683c3e278769487148c7cd61e725a751..3988e3f00d87d077162fbe043532f7ca121b6b2c 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 a4ea81c1b032f65229ac7674c75b20ce59c8b2b9..44cf27ec65af2885a65340750105a2c42da70ad2 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 d1833f37e2dbfe380defe15f1cf794019c070489..6750b6f614208e1d91c3f42a6fd26128fc781e67 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 fb91639d2ac2fad7e667df358978758fa4fc8737..8ae2c131955c4a2e8fc978007dae57f96fce6463 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. */