+2017-03-25 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR libgfortran/78881
+ * gfortran.dg/dtio_26.f90: New test.
+
2017-03-25 Paul Thomas <pault@gcc.gnu.org>
PR fortran/80156
--- /dev/null
+! { dg-do run }
+! PR78881 test for correct end of record condition and ignoring advance=
+module t_m
+ use, intrinsic :: iso_fortran_env, only : iostat_end, iostat_eor, output_unit
+ implicit none
+ type, public :: t
+ character(len=:), allocatable :: m_s
+ contains
+ procedure, pass(this) :: read_t
+ generic :: read(formatted) => read_t
+ end type t
+contains
+subroutine read_t(this, lun, iotype, vlist, istat, imsg)
+ class(t), intent(inout) :: this
+ integer, intent(in) :: lun
+ character(len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: istat
+ character(len=*), intent(inout) :: imsg
+ character(len=1) :: c
+ integer :: i
+ i = 0 ; imsg=''
+ loop_read: do
+ i = i + 1
+ read( unit=lun, fmt='(a1)', iostat=istat, iomsg=imsg) c
+ select case ( istat )
+ case ( 0 )
+ if (i.eq.1 .and. c.ne.'h') exit loop_read
+ !write( output_unit, fmt=sfmt) "i = ", i, ", c = ", c
+ case ( iostat_end )
+ !write( output_unit, fmt=sfmt) "i = ", i, ", istat = iostat_end"
+ exit loop_read
+ case ( iostat_eor )
+ !write( output_unit, fmt=sfmt) "i = ", i, ", istat = iostat_eor"
+ exit loop_read
+ case default
+ !write( output_unit, fmt=sfmt) "i = ", i, ", istat = ", istat
+ exit loop_read
+ end select
+ if (i.gt.10) exit loop_read
+ end do loop_read
+end subroutine read_t
+end module t_m
+
+program p
+ use t_m, only : t
+ implicit none
+
+ character(len=:), allocatable :: s
+ type(t) :: foo
+ character(len=256) :: imsg
+ integer :: istat
+
+ open(10, status="scratch")
+ write(10,'(a)') 'hello'
+ rewind(10)
+ read(unit=10, fmt='(dt)', iostat=istat, iomsg=imsg) foo
+ if (imsg.ne."End of record") call abort
+ rewind(10)
+ read(unit=10, fmt=*, iostat=istat, iomsg=imsg) foo
+ if (imsg.ne."End of record") call abort
+ s = "hello"
+ read( unit=s, fmt='(dt)', iostat=istat, iomsg=imsg) foo
+ if (imsg.ne."End of record") call abort
+ read( unit=s, fmt=*, iostat=istat, iomsg=imsg) foo
+ if (imsg.ne."End of record") call abort
+end program p
+
+! { dg-final { cleanup-modules "t_m" } }
+2017-03-25 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR libgfortran/78881
+ * io/io.h (st_parameter_dt): Rename unused component last_char to
+ child_saved_iostat. Move comment to gfc_unit.
+ * io/list_read.c (list_formatted_read_scalar): After call to
+ child READ procedure, save the returned iostat value for later
+ check. (finish_list_read): Only finish READ if child_saved_iostat
+ was OK.
+ * io/transfer.c (read_sf_internal): If there is a saved character
+ in last character, seek back one. Add a new check for EOR
+ condition. (read_sf): If there is a saved character
+ in last character, seek back one. (formatted_transfer_scalar_read):
+ Initialize last character before invoking child procedure.
+ (data_transfer_init): If child dtio, set advance
+ status to nonadvancing. Move update of size and check for EOR
+ condition to before child dtio return.
+
2017-03-17 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/79956
unsigned expanded_read : 1;
/* 13 unused bits. */
- /* Used for ungetc() style functionality. Possible values
- are an unsigned char, EOF, or EOF - 1 used to mark the
- field as not valid. */
- int last_char; /* No longer used, moved to gfc_unit. */
+ int child_saved_iostat;
int nml_delim;
int repeat_count;
int saved_length;
/* DTIO Parent/Child procedure, 0 = parent, >0 = child level. */
int child_dtio;
+
+ /* Used for ungetc() style functionality. Possible values
+ are an unsigned char, EOF, or EOF - 1 used to mark the
+ field as not valid. */
int last_char;
bool has_size;
GFC_IO_INT size_used;
dtp->u.p.fdtio_ptr (p, &unit, iotype, &vlist,
child_iostat, child_iomsg,
iotype_len, child_iomsg_len);
+ dtp->u.p.child_saved_iostat = *child_iostat;
dtp->u.p.current_unit->child_dtio--;
}
break;
/* Set the next_char and push_char worker functions. */
set_workers (dtp);
- c = next_char (dtp);
- if (c == EOF)
+ if (likely (dtp->u.p.child_saved_iostat == LIBERROR_OK))
{
- free_line (dtp);
- hit_eof (dtp);
- return;
+ c = next_char (dtp);
+ if (c == EOF)
+ {
+ free_line (dtp);
+ hit_eof (dtp);
+ return;
+ }
+ if (c != '\n')
+ eat_line (dtp);
}
- if (c != '\n')
- eat_line (dtp);
}
free_line (dtp);
read_sf_internal (st_parameter_dt *dtp, int * length)
{
static char *empty_string[0];
- char *base;
+ char *base = NULL;
int lorig;
/* Zero size array gives internal unit len of 0. Nothing to read. */
return (char*) empty_string;
}
+ /* There are some cases with mixed DTIO where we have read a character
+ and saved it in the last character buffer, so we need to backup. */
+ if (unlikely (dtp->u.p.current_unit->child_dtio > 0 &&
+ dtp->u.p.current_unit->last_char != EOF - 1))
+ {
+ dtp->u.p.current_unit->last_char = EOF - 1;
+ sseek (dtp->u.p.current_unit->s, -1, SEEK_CUR);
+ }
+
lorig = *length;
if (is_char4_unit(dtp))
{
return NULL;
}
+ if (base && *base == 0)
+ {
+ generate_error (&dtp->common, LIBERROR_EOR, NULL);
+ return NULL;
+ }
+
dtp->u.p.current_unit->bytes_left -= *length;
if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ||
return (char*) empty_string;
}
+ /* There are some cases with mixed DTIO where we have read a character
+ and saved it in the last character buffer, so we need to backup. */
+ if (unlikely (dtp->u.p.current_unit->child_dtio > 0 &&
+ dtp->u.p.current_unit->last_char != EOF - 1))
+ {
+ dtp->u.p.current_unit->last_char = EOF - 1;
+ fbuf_seek (dtp->u.p.current_unit, -1, SEEK_CUR);
+ }
+
n = seen_comma = 0;
/* Read data into format buffer and scan through it. */
/* Call the user defined formatted READ procedure. */
dtp->u.p.current_unit->child_dtio++;
+ dtp->u.p.current_unit->last_char = EOF - 1;
dtp->u.p.fdtio_ptr (p, &unit, iotype, f->u.udf.vlist,
child_iostat, child_iomsg,
iotype_len, child_iomsg_len);
}
}
+ /* Child IO is non-advancing and any ADVANCE= specifier is ignored.
+ F2008 9.6.2.4 */
+ if (dtp->u.p.current_unit->child_dtio > 0)
+ dtp->u.p.advance_status = ADVANCE_NO;
+
if (read_flag)
{
dtp->u.p.current_unit->previous_nonadvancing_write = 0;
namelist_write (dtp);
}
+ if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+ *dtp->size = dtp->u.p.current_unit->size_used;
+
+ if (dtp->u.p.eor_condition)
+ {
+ generate_error (&dtp->common, LIBERROR_EOR, NULL);
+ goto done;
+ }
+
if (dtp->u.p.current_unit && (dtp->u.p.current_unit->child_dtio > 0))
{
if (cf & IOPARM_DT_HAS_FORMAT)
return;
}
- if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- *dtp->size = dtp->u.p.current_unit->size_used;
-
- if (dtp->u.p.eor_condition)
- {
- generate_error (&dtp->common, LIBERROR_EOR, NULL);
- goto done;
- }
-
if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
{
if (dtp->u.p.current_unit && current_mode (dtp) == UNFORMATTED_SEQUENTIAL)
projects / gcc.git / commitdiff