re PR fortran/31618 ([4.2, 4.1 only] backspace intrinsic is not working on an unformatted file)
2007-04-23 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/31618 * io/transfer.c (read_block_direct): Instead of calling us_read, set dtp->u.p.current_unit->current_record = 0 so that pre_position will read the record marker. (data_transfer_init): For different error conditions, call generate_error, then return. 2007-04-23 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/31618 * gfortran.dg/backspace_8.f: New test case. From-SVN: r124079
This commit is contained in:
Thomas Koenig
parent
10e4d956c1
commit
e08e57d0c5
4 changed files with 101 additions and 38 deletions
|
|
@ -1,3 +1,8 @@
|
|||
2007-04-23 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/31618
|
||||
* gfortran.dg/backspace_8.f: New test case.
|
||||
|
||||
2007-04-23 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/31630
|
||||
|
|
|
|||
18
gcc/testsuite/gfortran.dg/backspace_8.f
Normal file
18
gcc/testsuite/gfortran.dg/backspace_8.f
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
C { dg-do run }
|
||||
C PR libfortran/31618 - backspace after an error didn't work.
|
||||
program main
|
||||
character*78 msg
|
||||
open (21, file="backspace_7.dat", form="unformatted")
|
||||
write (21) 42, 43
|
||||
write (21) 4711, 4712
|
||||
write (21) -1, -4
|
||||
rewind (21)
|
||||
read (21) i,j
|
||||
read (21,err=100,end=100) i,j,k
|
||||
call abort
|
||||
100 continue
|
||||
backspace 21
|
||||
read (21) i,j
|
||||
if (i .ne. 4711 .or. j .ne. 4712) call abort
|
||||
close (21,status="delete")
|
||||
end
|
||||
|
|
@ -1,3 +1,12 @@
|
|||
2007-04-23 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/31618
|
||||
* io/transfer.c (read_block_direct): Instead of calling us_read,
|
||||
set dtp->u.p.current_unit->current_record = 0 so that pre_position
|
||||
will read the record marker.
|
||||
(data_transfer_init): For different error conditions, call
|
||||
generate_error, then return.
|
||||
|
||||
2007-04-19 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||
|
||||
* runtime/main.c (please_free_exe_path_when_done): New variable.
|
||||
|
|
|
|||
|
|
@ -494,11 +494,11 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
|
|||
}
|
||||
else
|
||||
{
|
||||
/* Let's make sure the file position is correctly set for the
|
||||
next read statement. */
|
||||
/* Let's make sure the file position is correctly pre-positioned
|
||||
for the next read statement. */
|
||||
|
||||
dtp->u.p.current_unit->current_record = 0;
|
||||
next_record_r_unf (dtp, 0);
|
||||
us_read (dtp, 0);
|
||||
generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
|
||||
return;
|
||||
}
|
||||
|
|
@ -1769,15 +1769,18 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
|
|||
/* Check the action. */
|
||||
|
||||
if (read_flag && dtp->u.p.current_unit->flags.action == ACTION_WRITE)
|
||||
generate_error (&dtp->common, ERROR_BAD_ACTION,
|
||||
"Cannot read from file opened for WRITE");
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_BAD_ACTION,
|
||||
"Cannot read from file opened for WRITE");
|
||||
return;
|
||||
}
|
||||
|
||||
if (!read_flag && dtp->u.p.current_unit->flags.action == ACTION_READ)
|
||||
generate_error (&dtp->common, ERROR_BAD_ACTION,
|
||||
"Cannot write to file opened for READ");
|
||||
|
||||
if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
|
||||
return;
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_BAD_ACTION,
|
||||
"Cannot write to file opened for READ");
|
||||
return;
|
||||
}
|
||||
|
||||
dtp->u.p.first_item = 1;
|
||||
|
||||
|
|
@ -1786,14 +1789,14 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
|
|||
if ((cf & IOPARM_DT_HAS_FORMAT) != 0)
|
||||
parse_format (dtp);
|
||||
|
||||
if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
|
||||
return;
|
||||
|
||||
if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED
|
||||
&& (cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT))
|
||||
!= 0)
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"Format present for UNFORMATTED data transfer");
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"Format present for UNFORMATTED data transfer");
|
||||
return;
|
||||
}
|
||||
|
||||
if ((cf & IOPARM_DT_HAS_NAMELIST_NAME) != 0 && dtp->u.p.ionml != NULL)
|
||||
{
|
||||
|
|
@ -1803,13 +1806,19 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
|
|||
}
|
||||
else if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
|
||||
!(cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT)))
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"Missing format for FORMATTED data transfer");
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"Missing format for FORMATTED data transfer");
|
||||
}
|
||||
|
||||
if (is_internal_unit (dtp)
|
||||
&& dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED)
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"Internal file cannot be accessed by UNFORMATTED data transfer");
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"Internal file cannot be accessed by UNFORMATTED "
|
||||
"data transfer");
|
||||
return;
|
||||
}
|
||||
|
||||
/* Check the record or position number. */
|
||||
|
||||
|
|
@ -1839,49 +1848,71 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
|
|||
if (dtp->u.p.advance_status != ADVANCE_UNSPECIFIED)
|
||||
{
|
||||
if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"ADVANCE specification conflicts with sequential access");
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"ADVANCE specification conflicts with sequential access");
|
||||
return;
|
||||
}
|
||||
|
||||
if (is_internal_unit (dtp))
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"ADVANCE specification conflicts with internal file");
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"ADVANCE specification conflicts with internal file");
|
||||
return;
|
||||
}
|
||||
|
||||
if ((cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT))
|
||||
!= IOPARM_DT_HAS_FORMAT)
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"ADVANCE specification requires an explicit format");
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"ADVANCE specification requires an explicit format");
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
if (read_flag)
|
||||
{
|
||||
if ((cf & IOPARM_EOR) != 0 && dtp->u.p.advance_status != ADVANCE_NO)
|
||||
generate_error (&dtp->common, ERROR_MISSING_OPTION,
|
||||
"EOR specification requires an ADVANCE specification of NO");
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_MISSING_OPTION,
|
||||
"EOR specification requires an ADVANCE specification "
|
||||
"of NO");
|
||||
return;
|
||||
}
|
||||
|
||||
if ((cf & IOPARM_DT_HAS_SIZE) != 0 && dtp->u.p.advance_status != ADVANCE_NO)
|
||||
generate_error (&dtp->common, ERROR_MISSING_OPTION,
|
||||
"SIZE specification requires an ADVANCE specification of NO");
|
||||
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_MISSING_OPTION,
|
||||
"SIZE specification requires an ADVANCE specification of NO");
|
||||
return;
|
||||
}
|
||||
}
|
||||
else
|
||||
{ /* Write constraints. */
|
||||
if ((cf & IOPARM_END) != 0)
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"END specification cannot appear in a write statement");
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"END specification cannot appear in a write statement");
|
||||
return;
|
||||
}
|
||||
|
||||
if ((cf & IOPARM_EOR) != 0)
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"EOR specification cannot appear in a write statement");
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"EOR specification cannot appear in a write statement");
|
||||
return;
|
||||
}
|
||||
|
||||
if ((cf & IOPARM_DT_HAS_SIZE) != 0)
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"SIZE specification cannot appear in a write statement");
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
|
||||
"SIZE specification cannot appear in a write statement");
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
if (dtp->u.p.advance_status == ADVANCE_UNSPECIFIED)
|
||||
dtp->u.p.advance_status = ADVANCE_YES;
|
||||
if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
|
||||
return;
|
||||
|
||||
/* Sanity checks on the record number. */
|
||||
if ((cf & IOPARM_DT_HAS_REC) != 0)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue