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 <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
This commit is contained in:
parent
fe6e62137f
commit
962952b96f
|
@ -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
|
||||
|
|
|
@ -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
|
|
@ -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>
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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';
|
||||
}
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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);
|
||||
|
|
Loading…
Reference in New Issue