re PR fortran/29277 (Formated stream output: Translate "\n" / achar(10) into "\r...

2006-10-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/29277
	* io/list_read.c (next_char): Update strm_pos.
	(eat_separator): Delete extra call to unget_char.
	* io/transfer.c (read_block): Use read_sf for formatted stream I/O.
	(next_record_r): Update strm_pos for formatted stream I/O and handle
	end-of-record correctly.
	(next_record_w): Ditto.
	(next_record): Enable next record (r/w) functions and update strm_pos.
	(finalize_transfer): Call next_record to finish the record.

From-SVN: r117846

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 2852bbb..ff0e246 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,15 @@
+2006-10-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libgfortran/29277
+       * io/list_read.c (next_char): Update strm_pos.
+       (eat_separator): Delete extra call to unget_char.
+       * io/transfer.c (read_block): Use read_sf for formatted stream I/O.
+       (next_record_r): Update strm_pos for formatted stream I/O and handle
+       end-of-record correctly.
+       (next_record_w): Ditto.
+       (next_record): Enable next record (r/w) functions and update strm_pos.
+       (finalize_transfer): Call next_record to finish the record.
+
 2006-10-13  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        * m4/spacing.m4: Use scalbn[f,l] if ldexp[f,l] is unavailable.

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 0dcb3db..47ceb47 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -187,6 +187,9 @@ next_char (st_parameter_dt *dtp)
   length = 1;
 
   p = salloc_r (dtp->u.p.current_unit->s, &length);
+  
+  if (is_stream_io (dtp))
+    dtp->u.p.current_unit->strm_pos++;
 
   if (is_internal_unit(dtp))
     {
@@ -294,10 +297,7 @@ eat_separator (st_parameter_dt *dtp)
       if (n == '\n')
        dtp->u.p.at_eol = 1;
       else
-        {
-         unget_char (dtp, n);
-         unget_char (dtp, c);
-        } 
+       unget_char (dtp, n);
       break;
 
     case '\n':

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 663a1bf..b680d20 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -324,6 +324,13 @@ read_block (st_parameter_dt *dtp, int *length)
          return NULL;
        }
 
+      if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
+       {
+         source = read_sf (dtp, length, 0);
+         dtp->u.p.current_unit->strm_pos +=
+           (gfc_offset) (*length + dtp->u.p.sf_seen_eor);
+         return source;
+       }
       nread = *length;
       source = salloc_r (dtp->u.p.current_unit->s, &nread);
 
@@ -1921,8 +1928,7 @@ next_record_r (st_parameter_dt *dtp)
 
   switch (current_mode (dtp))
     {
-    /* No records in STREAM I/O.  */
-    case FORMATTED_STREAM:
+    /* No records in unformatted STREAM I/O.  */
     case UNFORMATTED_STREAM:
       return;
     
@@ -1970,6 +1976,7 @@ next_record_r (st_parameter_dt *dtp)
        }
       break;
 
+    case FORMATTED_STREAM:
     case FORMATTED_SEQUENTIAL:
       length = 1;
       /* sf_read has already terminated input because of an '\n'  */
@@ -2019,6 +2026,9 @@ next_record_r (st_parameter_dt *dtp)
              dtp->u.p.current_unit->endfile = AT_ENDFILE;
              break;
            }
+
+         if (is_stream_io (dtp))
+           dtp->u.p.current_unit->strm_pos++;
        }
       while (*p != '\n');
 
@@ -2116,8 +2126,7 @@ next_record_w (st_parameter_dt *dtp, int done)
 
   switch (current_mode (dtp))
     {
-    /* No records in STREAM I/O.  */
-    case FORMATTED_STREAM:
+    /* No records in unformatted STREAM I/O.  */
     case UNFORMATTED_STREAM:
       return;
 
@@ -2168,6 +2177,7 @@ next_record_w (st_parameter_dt *dtp, int done)
 
       break;
 
+    case FORMATTED_STREAM:
     case FORMATTED_SEQUENTIAL:
 
       if (is_internal_unit (dtp))
@@ -2241,8 +2251,6 @@ next_record_w (st_parameter_dt *dtp, int done)
        }
       else
        {
-         if (dtp->u.p.current_unit->bytes_left == 0)
-           break;
 
          /* If this is the last call to next_record move to the farthest
          position reached in preparation for completing the record.
@@ -2266,6 +2274,9 @@ next_record_w (st_parameter_dt *dtp, int done)
 #endif
          if (swrite (dtp->u.p.current_unit->s, &crlf[2-len], &len) != 0)
            goto io_error;
+         
+         if (is_stream_io (dtp))
+           dtp->u.p.current_unit->strm_pos += len;
        }
 
       break;
@@ -2284,9 +2295,6 @@ next_record_w (st_parameter_dt *dtp, int done)
 void
 next_record (st_parameter_dt *dtp, int done)
 {
-  if (is_stream_io (dtp))
-    return;
-
   gfc_offset fp; /* File position.  */
 
   dtp->u.p.current_unit->read_bad = 0;
@@ -2296,18 +2304,22 @@ next_record (st_parameter_dt *dtp, int done)
   else
     next_record_w (dtp, done);
 
-  /* keep position up to date for INQUIRE */
-  dtp->u.p.current_unit->flags.position = POSITION_ASIS;
-  dtp->u.p.current_unit->current_record = 0;
-  if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
-   {
-    fp = file_position (dtp->u.p.current_unit->s);
-    /* Calculate next record, rounding up partial records.  */
-    dtp->u.p.current_unit->last_record = (fp + dtp->u.p.current_unit->recl - 1)
-                               / dtp->u.p.current_unit->recl;
-   }
-  else
-    dtp->u.p.current_unit->last_record++;
+  if (!is_stream_io (dtp))
+    {
+      /* keep position up to date for INQUIRE */
+      dtp->u.p.current_unit->flags.position = POSITION_ASIS;
+      dtp->u.p.current_unit->current_record = 0;
+      if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
+       {
+         fp = file_position (dtp->u.p.current_unit->s);
+         /* Calculate next record, rounding up partial records.  */
+         dtp->u.p.current_unit->last_record =
+           (fp + dtp->u.p.current_unit->recl - 1) /
+             dtp->u.p.current_unit->recl;
+       }
+      else
+       dtp->u.p.current_unit->last_record++;
+    }
 
   if (!done)
     pre_position (dtp);
@@ -2373,7 +2385,11 @@ finalize_transfer (st_parameter_dt *dtp)
       next_record (dtp, 1);
     }
   else
-    flush (dtp->u.p.current_unit->s);
+    {
+      if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
+       next_record (dtp, 1);
+      flush (dtp->u.p.current_unit->s);
+    }
 
   sfree (dtp->u.p.current_unit->s);
 }