2010-03-09 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR libfortran/43265
	* io/read.c: Include fbuf.h and unix.h to enable lower level I/O for
	read_x. (read_x): Replace the use of read_sf with equivalent lower level
	I/O, eliminating unneeded code and handling EOF and EOR conditions.
	* io/io.h: Revise prototype for read_sf.
	* io/transfer.c (read_sf): Delete no_error parameter and all uses of it.
	(read_block_form): Likewise.
	(next_record_r): Delete wrong code call to hit_eof.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@157310 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index bed26b9..1f6b514 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,14 @@
+2010-03-09  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libfortran/43265
+       * io/read.c: Include fbuf.h and unix.h to enable lower level I/O for
+       read_x. (read_x): Replace the use of read_sf with equivalent lower level
+       I/O, eliminating unneeded code and handling EOF and EOR conditions.
+       * io/io.h: Revise prototype for read_sf.
+       * io/transfer.c (read_sf): Delete no_error parameter and all uses of it.
+       (read_block_form): Likewise.
+       (next_record_r): Delete wrong code call to hit_eof.
+

 2010-03-08  Kai TIetz  <kai.tietz@onevision.com>
 
        PR/42950
 2010-03-08  Kai TIetz  <kai.tietz@onevision.com>
 
        PR/42950

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index b24f810..8f482e6 100644 (file)
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -642,7 +642,7 @@ internal_proto(type_name);
 extern void * read_block_form (st_parameter_dt *, int *);
 internal_proto(read_block_form);
 
 extern void * read_block_form (st_parameter_dt *, int *);
 internal_proto(read_block_form);
 

-extern char *read_sf (st_parameter_dt *, int *, int);
+extern char *read_sf (st_parameter_dt *, int *);

 internal_proto(read_sf);
 
 extern void *write_block (st_parameter_dt *, int);
 internal_proto(read_sf);
 
 extern void *write_block (st_parameter_dt *, int);

diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 43f4b76..a4c4a58 100644 (file)
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -24,7 +24,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 <http://www.gnu.org/licenses/>.  */
 
 #include "io.h"
 <http://www.gnu.org/licenses/>.  */
 
 #include "io.h"

+#include "fbuf.h"

 #include "format.h"
 #include "format.h"

+#include "unix.h"

 #include <string.h>
 #include <errno.h>
 #include <ctype.h>
 #include <string.h>
 #include <errno.h>
 #include <ctype.h>


@@ -1022,16 +1024,70 @@ bad_float:
  * and never look at it. */
 
 void
  * and never look at it. */
 
 void

-read_x (st_parameter_dt * dtp, int n)
+read_x (st_parameter_dt *dtp, int n)

 {
 {

+  int length;
+  char *p, q;
+

   if ((dtp->u.p.current_unit->pad_status == PAD_NO || is_internal_unit (dtp))
        && dtp->u.p.current_unit->bytes_left < n)
     n = dtp->u.p.current_unit->bytes_left;
   if ((dtp->u.p.current_unit->pad_status == PAD_NO || is_internal_unit (dtp))
        && dtp->u.p.current_unit->bytes_left < n)
     n = dtp->u.p.current_unit->bytes_left;

+    
+  if (n == 0)
+    return;

 
 

-  dtp->u.p.sf_read_comma = 0;
-  if (n > 0)
-    read_sf (dtp, &n, 1);
-  dtp->u.p.sf_read_comma = 1;
+  length = n;
+
+  if (is_internal_unit (dtp))
+    {
+      p = mem_alloc_r (dtp->u.p.current_unit->s, &length);
+      if (unlikely (length < n))
+       n = length;
+      goto done;
+    }
+
+  p = fbuf_read (dtp->u.p.current_unit, &length);
+  if (p == NULL || (length == 0 && dtp->u.p.item_count == 1))
+    {
+      hit_eof (dtp);
+      return;
+    }
+
+  n = 0;
+  while (n < length)
+    {
+      q = *p;
+      if (q == '\n' || q == '\r')
+       {
+         /* Unexpected end of line. Set the position.  */
+         fbuf_seek (dtp->u.p.current_unit, n + 1 ,SEEK_CUR);
+         dtp->u.p.sf_seen_eor = 1;
+
+         /* If we encounter a CR, it might be a CRLF.  */
+         if (q == '\r') /* Probably a CRLF */
+           {
+             /* See if there is an LF. Use fbuf_read rather then fbuf_getc so
+                the position is not advanced unless it really is an LF.  */
+             int readlen = 1;
+             p = fbuf_read (dtp->u.p.current_unit, &readlen);
+             if (*p == '\n' && readlen == 1)
+               {
+                 dtp->u.p.sf_seen_eor = 2;
+                 fbuf_seek (dtp->u.p.current_unit, 1 ,SEEK_CUR);
+               }
+           }
+         goto done;
+       }
+      n++;
+      p++;
+    } 
+
+  fbuf_seek (dtp->u.p.current_unit, n, SEEK_CUR);
+  
+ done:
+  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+    dtp->u.p.size_used += (GFC_IO_INT) n;
+  dtp->u.p.current_unit->bytes_left -= n;

   dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
 }
 
   dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
 }
 

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 63a18a6..c5d26a5 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -192,22 +192,12 @@ current_mode (st_parameter_dt *dtp)
    heap.  Hopefully this won't happen very often.  */
 
 char *
    heap.  Hopefully this won't happen very often.  */
 
 char *

-read_sf (st_parameter_dt *dtp, int * length, int no_error)
+read_sf (st_parameter_dt *dtp, int * length)

 {
   static char *empty_string[0];
   char *base, *p, q;
   int n, lorig, memread, seen_comma;
 
 {
   static char *empty_string[0];
   char *base, *p, q;
   int n, lorig, memread, seen_comma;
 

-  /* If we hit EOF previously with the no_error flag set (i.e. X, T,
-     TR edit descriptors), and we now try to read again, this time
-     without setting no_error.  */
-  if (!no_error && dtp->u.p.at_eof)
-    {
-      *length = 0;
-      hit_eof (dtp);
-      return NULL;
-    }
-

   /* If we have seen an eor previously, return a length of 0.  The
      caller is responsible for correctly padding the input field.  */
   if (dtp->u.p.sf_seen_eor)
   /* If we have seen an eor previously, return a length of 0.  The
      caller is responsible for correctly padding the input field.  */
   if (dtp->u.p.sf_seen_eor)


@@ -273,8 +263,6 @@ read_sf (st_parameter_dt *dtp, int * length, int no_error)
             so we can just continue with a short read.  */
          if (dtp->u.p.current_unit->pad_status == PAD_NO)
            {
             so we can just continue with a short read.  */
          if (dtp->u.p.current_unit->pad_status == PAD_NO)
            {

-             if (likely (no_error))
-               break;

              generate_error (&dtp->common, LIBERROR_EOR, NULL);
              return NULL;
            }
              generate_error (&dtp->common, LIBERROR_EOR, NULL);
              return NULL;
            }


@@ -304,7 +292,7 @@ read_sf (st_parameter_dt *dtp, int * length, int no_error)
      some other stuff. Set the relevant flags.  */
   if (lorig > *length && !dtp->u.p.sf_seen_eor && !seen_comma)
     {
      some other stuff. Set the relevant flags.  */
   if (lorig > *length && !dtp->u.p.sf_seen_eor && !seen_comma)
     {

-      if (n > 0 || no_error)
+      if (n > 0)

         {
          if (dtp->u.p.advance_status == ADVANCE_NO)
            {
         {
          if (dtp->u.p.advance_status == ADVANCE_NO)
            {


@@ -386,7 +374,7 @@ read_block_form (st_parameter_dt *dtp, int * nbytes)
       (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL ||
        dtp->u.p.current_unit->flags.access == ACCESS_STREAM))
     {
       (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL ||
        dtp->u.p.current_unit->flags.access == ACCESS_STREAM))
     {

-      source = read_sf (dtp, nbytes, 0);
+      source = read_sf (dtp, nbytes);

       dtp->u.p.current_unit->strm_pos +=
        (gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor);
       return source;
       dtp->u.p.current_unit->strm_pos +=
        (gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor);
       return source;


@@ -2822,8 +2810,6 @@ next_record_r (st_parameter_dt *dtp)
                {
                   if (errno != 0)
                     generate_error (&dtp->common, LIBERROR_OS, NULL);
                {
                   if (errno != 0)
                     generate_error (&dtp->common, LIBERROR_OS, NULL);

-                  else
-                    hit_eof (dtp);

                  break;
                 }
              
                  break;
                 }