OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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 2007-04-23 19:43:54 +00:00
parent 10e4d956c1
commit e08e57d0c5
4 changed files with 101 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -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
View 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

9
libgfortran/ChangeLog
View File

@ -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.

107
libgfortran/io/transfer.c
View File

@ -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)