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 4ce34eb..66bf1af 100644 (file)
--- 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 bd154f1..eb09caf 100644 (file)
--- 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 1dda1fb..a6fc1c1 100644 (file)
--- 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 d0bae6e..109e090 100644 (file)
--- 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 e0b251a..48cc2a1 100644 (file)
--- 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 939c4a1..3988e3f 100644 (file)
--- 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 a4ea81c..44cf27e 100644 (file)
--- 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 d1833f3..6750b6f 100644 (file)
--- 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 fb91639..8ae2c13 100644 (file)
--- 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.  */