From: Jerry DeLisle Date: Sat, 15 Mar 2014 23:06:44 +0000 (+0000) Subject: backport: re PR fortran/58324 (Bogus END-of-line error with list-directed I/O of... X-Git-Tag: releases/gcc-4.7.4~198 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=962952b96f5a197396af25725336e1df5c908c85;p=thirdparty%2Fgcc.git backport: re PR fortran/58324 (Bogus END-of-line error with list-directed I/O of file without trailing sequential record marker) 2014-03-15 Jerry DeLisle 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 0058553c2944..ca7f17992026 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2014-03-15 Jerry DeLisle + + Backport from mainline + PR libfortran/58324 + * gfortran.dg/list_read_12.f90: New test. + 2014-03-09 Janus Weil 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 index 000000000000..811ef152a5b3 --- /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 c8f77fe00adc..7d6fd05ee024 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,25 @@ +2014-03-15 Jerry DeLisle + + 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 Dominique d'Humieres diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c b/libgfortran/intrinsics/string_intrinsics_inc.c index 8335a38d9491..2f7a5ec61a5e 100644 --- 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 e44cc14a784e..fa34e67a0898 100644 --- 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 aa41bc7b9d28..43eea8367fa7 100644 --- 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 7c71b090e3a6..d71593b19466 100644 --- 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 #include +#include /* 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 148dcfb59a0e..4cc40a318d08 100644 --- 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);