[libgfortran] Correct handling of CRLF as line terminator

[François-Xavier Coudert <fxcoudert at gmail dot com>]

Attached patch makes libgfortran correctly handle CRLF as line
terminator (support until now was incomplete), for both reading (the
library can read both CRLF and LF files) and writing (the library will
write LF or CRLF as line terminators, depending on the value of
HAVE_CRLF when the compiler is built).

The patch to unix.c makes it possible to define HAVE_CRLF manually on
systems that don't have O_BINARY. We can thus run the testsuite using
CRLF on a non-CRLF system, and it opens the possibility of using a
compile-time option for line terminators instead of having this built
in the compiler. All the other files are the patch to handle reading
and writing of CRLF.

Regtested on i686-linux, with and without HAVE_CRLF. Introduces no
regression without it (the usual linux config) and fixes all testsuite
failures that existed on CRLF systems.

OK for 4.1 and mainline?

FX

:ADDPATCH libgfortran:

Attachment: crlf.ChangeLog
Description: Binary data

Index: libgfortran/io/list_read.c
===================================================================
--- libgfortran/io/list_read.c	(revision 107406)
+++ libgfortran/io/list_read.c	(working copy)
@@ -201,7 +201,7 @@
 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 @@
       dtp->u.p.input_complete = 1;
       break;
 
+    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':
-    case '\r':
       dtp->u.p.at_eol = 1;
       break;
 
@@ -263,7 +273,7 @@
       else
 	{
 	  c = eat_spaces (dtp);
-	  if (c == '\n')
+	  if (c == '\n' || c == '\r')
 	    goto restart;
 	}
 
@@ -796,7 +806,7 @@
 	      goto done;
 	    }
 
-	  if (c != '\n')
+	  if (c != '\n' && c != '\r')
 	    push_char (dtp, c);
 	  break;
 
@@ -1749,32 +1759,56 @@
 	  /* "&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.  */
Index: libgfortran/io/io.h
===================================================================
--- libgfortran/io/io.h	(revision 107406)
+++ libgfortran/io/io.h	(working copy)
@@ -383,6 +383,10 @@
 	  char reversion_flag; /* Format reversion has occurred.  */
 	  char first_item;
 	  char seen_dollar;
+	  /* 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) */
 	  char sf_seen_eor;
 	  char eor_condition;
 	  char no_leading_blank;
Index: libgfortran/io/unix.c
===================================================================
--- libgfortran/io/unix.c	(revision 107406)
+++ libgfortran/io/unix.c	(working copy)
@@ -1037,7 +1037,7 @@
 
   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 @@
 
   /* rwflag |= O_LARGEFILE; */
 
-#ifdef HAVE_CRLF
+#if defined(HAVE_CRLF) && defined(O_BINARY)
   crflag |= O_BINARY;
 #endif
 
@@ -1475,7 +1475,7 @@
 }
 
 
-/* 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
Index: libgfortran/io/transfer.c
===================================================================
--- libgfortran/io/transfer.c	(revision 107406)
+++ libgfortran/io/transfer.c	(working copy)
@@ -136,7 +136,8 @@
 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 @@
 	  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 @@
 	    }
 
 	  *length = n;
-	  dtp->u.p.sf_seen_eor = 1;
+	  dtp->u.p.sf_seen_eor = (crlf ? 2 : 1);
 	  break;
 	}
 
@@ -803,10 +817,20 @@
 	      /* 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)
 		{
Index: libgfortran/io/write.c
===================================================================
--- libgfortran/io/write.c	(revision 107406)
+++ libgfortran/io/write.c	(working copy)
@@ -1536,7 +1536,11 @@
 
   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 @@
 	  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 @@
 	  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.  */
 
Index: gcc/testsuite/gfortran.dg/ftell_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/ftell_2.f90	(revision 107406)
+++ gcc/testsuite/gfortran.dg/ftell_2.f90	(working copy)
@@ -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
Index: gcc/testsuite/gfortran.dg/ftell_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/ftell_1.f90	(revision 107406)
+++ gcc/testsuite/gfortran.dg/ftell_1.f90	(working copy)
@@ -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