backport: re PR fortran/58324 (Bogus END-of-line error with list-directed I/O of...

2014-03-15  Jerry DeLisle  <jvdelisle@gcc.gnu>

	Backport from mainline
	PR libfortran/58324
	PR libfortran/38199
	* intrinsics/string_intriniscs_inc.c (string_len_trim):
	Remove prototypes for string_len_trim and move to...
	* libgfortran.h (string_len_trim): ... here and
	(string_len_trim_char4): ...here.
	* io/list_read.c (finish_list_read): Read one character to check
	for the end of the file.  If it is the end, then issue the file
	end error message.  If not, use eat_line to reach the end
	without giving error.  The next attempt to read will then
	issue the error as described above.
	* io/read.c (read_decimal): Quickly skip spaces to avoid calls
	to next_char.
	* io/unit.c (is_trim_ok): New helper function to check various
	conditions to see if its OK to trim the internal unit string.
	(get_internal_unit): Use LEN_TRIM to shorten selected internal
	unit strings for optimizing READ. Enable this optimization for
	formatted READ.

	Backport from mainline
	PR libfortran/58324
	* gfortran.dg/list_read_12.f90: New test.

From-SVN: r208599

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0058553c294483a91737dfce078e658286394d64..ca7f17992026c6a1e344651bc5849afc2eddada8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2014-03-15  Jerry DeLisle  <jvdelisle@gcc.gnu>
+
+       Backport from mainline
+       PR libfortran/58324
+       * gfortran.dg/list_read_12.f90: New test.
+
 2014-03-09  Janus Weil  <janus@gcc.gnu.org>
 
        Backport from 4.8

diff --git a/gcc/testsuite/gfortran.dg/list_read_12.f90 b/gcc/testsuite/gfortran.dg/list_read_12.f90
new file mode 100644 (file)
index 0000000..811ef15
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/list_read_12.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR58324 Bogus end of file condition
+integer :: i, ios
+open(99, access='stream', form='unformatted')
+write(99) "5 a"
+close(99)
+
+open(99, access='sequential', form='formatted')
+read(99, *, iostat=ios) i
+if (ios /= 0) call abort
+end

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index c8f77fe00adc82febb8ed1765e8b7ce50e77a908..7d6fd05ee024ea66bb523eb8ad390fde9baa71ac 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,25 @@
+2014-03-15  Jerry DeLisle  <jvdelisle@gcc.gnu>
+
+       Backport from mainline
+       PR libfortran/58324
+       PR libfortran/38199
+       * intrinsics/string_intriniscs_inc.c (string_len_trim):
+       Remove prototypes for string_len_trim and move to...
+       * libgfortran.h (string_len_trim): ... here and
+       (string_len_trim_char4): ...here.
+       * io/list_read.c (finish_list_read): Read one character to check
+       for the end of the file.  If it is the end, then issue the file
+       end error message.  If not, use eat_line to reach the end
+       without giving error.  The next attempt to read will then
+       issue the error as described above.
+       * io/read.c (read_decimal): Quickly skip spaces to avoid calls
+       to next_char.
+       * io/unit.c (is_trim_ok): New helper function to check various
+       conditions to see if its OK to trim the internal unit string.
+       (get_internal_unit): Use LEN_TRIM to shorten selected internal
+       unit strings for optimizing READ. Enable this optimization for
+       formatted READ.
+
 2014-02-15  Jerry DeLisle  <jvdelisle@gcc.gnu>
            Dominique d'Humieres  <dominiq@lps.ens.fr>
 

diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c b/libgfortran/intrinsics/string_intrinsics_inc.c
index 8335a38d949143bfb61f1af123f7a6cbc27b494e..2f7a5ec61a5e545e578c8704e62ae0f6e294c97e 100644 (file)
--- a/libgfortran/intrinsics/string_intrinsics_inc.c
+++ b/libgfortran/intrinsics/string_intrinsics_inc.c
@@ -44,9 +44,6 @@ extern void concat_string (gfc_charlen_type, CHARTYPE *,
                           gfc_charlen_type, const CHARTYPE *);
 export_proto(concat_string);
 
-extern gfc_charlen_type string_len_trim (gfc_charlen_type, const CHARTYPE *);
-export_proto(string_len_trim);
-
 extern void adjustl (CHARTYPE *, gfc_charlen_type, const CHARTYPE *);
 export_proto(adjustl);
 

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index e44cc14a784efb03d653f1de25b21ff7c423be7a..fa34e67a08982b5b6d49520756c5cafe7d12d25d 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -1985,8 +1985,6 @@ list_formatted_read (st_parameter_dt *dtp, bt type, void *p, int kind,
 void
 finish_list_read (st_parameter_dt *dtp)
 {
-  int err;
-
   free_saved (dtp);
 
   fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode);
@@ -1997,9 +1995,22 @@ finish_list_read (st_parameter_dt *dtp)
       return;
     }
 
-  err = eat_line (dtp);
-  if (err == LIBERROR_END)
-    hit_eof (dtp);
+  if (!is_internal_unit (dtp))
+    {
+      int c;
+      c = next_char (dtp);
+      if (c == EOF)
+       {
+         free_line (dtp);
+         hit_eof (dtp);
+         return;
+       }
+      if (c != '\n')
+       eat_line (dtp);
+    }
+
+  free_line (dtp);
+
 }
 
 /*                     NAMELIST INPUT

diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index aa41bc7b9d288d4884acc14a69f0f0492e28b4d0..43eea8367fa7fc625c6245338f877537e86c8b2c 100644 (file)
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -667,7 +667,13 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
        
       if (c == ' ')
         {
-         if (dtp->u.p.blank_status == BLANK_NULL) continue;
+         if (dtp->u.p.blank_status == BLANK_NULL)
+           {
+             /* Skip spaces.  */
+             for ( ; w > 0; p++, w--)
+               if (*p != ' ') break; 
+             continue;
+           }
          if (dtp->u.p.blank_status == BLANK_ZERO) c = '0';
         }
         

diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 7c71b090e3a654f234e41806acd0e8d126d9150c..d71593b1946672ce05496c2ba82e89bb5bd1fd3f 100644 (file)
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -30,6 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include "unix.h"
 #include <stdlib.h>
 #include <string.h>
+#include <stdbool.h>
 
 
 /* IO locking rules:
@@ -377,6 +378,38 @@ find_or_create_unit (int n)
 }
 
 
+/* Helper function to check rank, stride, format string, and namelist.
+   This is used for optimization. You can't trim out blanks or shorten
+   the string if trailing spaces are significant.  */
+static bool
+is_trim_ok (st_parameter_dt *dtp)
+{
+  /* Check rank and stride.  */
+  if (dtp->internal_unit_desc
+      && (GFC_DESCRIPTOR_RANK (dtp->internal_unit_desc) > 1
+         || GFC_DESCRIPTOR_STRIDE(dtp->internal_unit_desc, 0) != 1))
+    return false;
+  /* Format strings can not have 'BZ' or '/'.  */
+  if (dtp->common.flags & IOPARM_DT_HAS_FORMAT)
+    {
+      char *p = dtp->format;
+      off_t i;
+      if (dtp->common.flags & IOPARM_DT_HAS_BLANK)
+       return false;
+      for (i = 0; i < dtp->format_len; i++)
+       {
+         if (p[i] == '/') return false;
+         if (p[i] == 'b' || p[i] == 'B')
+           if (p[i+1] == 'z' || p[i+1] == 'Z')
+             return false;
+       }
+    }
+  if (dtp->u.p.ionml) /* A namelist.  */
+    return false;
+  return true;
+}
+
+
 gfc_unit *
 get_internal_unit (st_parameter_dt *dtp)
 {
@@ -410,6 +443,22 @@ get_internal_unit (st_parameter_dt *dtp)
      some other file I/O unit.  */
   iunit->unit_number = -1;
 
+  /* As an optimization, adjust the unit record length to not
+     include trailing blanks. This will not work under certain conditions
+     where trailing blanks have significance.  */
+  if (dtp->u.p.mode == READING && is_trim_ok (dtp))
+    {
+      int len;
+      if (dtp->common.unit == 0)
+         len = string_len_trim (dtp->internal_unit_len,
+                                                  dtp->internal_unit);
+      else
+         len = string_len_trim_char4 (dtp->internal_unit_len,
+                             (const gfc_char4_t*) dtp->internal_unit);
+      dtp->internal_unit_len = len; 
+      iunit->recl = dtp->internal_unit_len;
+    }
+
   /* Set up the looping specification from the array descriptor, if any.  */
 
   if (is_array_io (dtp))

diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 148dcfb59a0edafa9ca0beee3a2d15cf3f042385..4cc40a318d081d8d81b83dc447404bef305d74e7 100644 (file)
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -788,6 +788,13 @@ internal_proto(fstrcpy);
 extern gfc_charlen_type cf_strcpy (char *, gfc_charlen_type, const char *);
 internal_proto(cf_strcpy);
 
+extern gfc_charlen_type string_len_trim (gfc_charlen_type, const char *);
+export_proto(string_len_trim);
+
+extern gfc_charlen_type string_len_trim_char4 (gfc_charlen_type,
+                                              const gfc_char4_t *);
+export_proto(string_len_trim_char4);
+
 /* io/intrinsics.c */
 
 extern void flush_all_units (void);