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

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gfortran.dg/ftell_1.f90

 ! { 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

gcc/testsuite/gfortran.dg/ftell_2.f90

 ! { 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

libgfortran/ChangeLog

+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

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;

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.  */

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)
 		{

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

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.  */