mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-13 13:41:12 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/44477 (Sequential I/O with END FILE: File position should be at EoF)

Browse Source 
2010-06-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/44477
	* io/file_pos.c (st_endfile): Add check for ENDFILE when file is
	already positioned after the EOF marker. Use find_or_create_unit
	instead of find_unit. If unit is not connected, connect it and create 
	the file with default settings.
	* io/transfer.c (data_transfer_init):  Add check for attempted READ or
	WRITE when file is already positioned after the EOF marker.

From-SVN: r161020
This commit is contained in:
Jerry DeLisle 2010-06-19 00:58:28 +00:00
parent b3b5bf9468
commit b9983d610a
3 changed files with 80 additions and 11 deletions

10
libgfortran/ChangeLog

@ -1,3 +1,13 @@
2010-06-18 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/44477
* io/file_pos.c (st_endfile): Add check for ENDFILE when file is
already positioned after the EOF marker. Use find_or_create_unit
instead of find_unit. If unit is not connected, connect it and create
the file with default settings.
* io/transfer.c (data_transfer_init): Add check for attempted READ or
WRITE when file is already positioned after the EOF marker.
2010-06-10 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
* intrinsics/selected_char_kind.c (selected_char_kind): Fix

57
libgfortran/io/file_pos.c

@ -283,8 +283,17 @@ st_endfile (st_parameter_filepos *fpp)
if (u->flags.access == ACCESS_DIRECT)
{
generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
"Cannot perform ENDFILE on a file opened"
" for DIRECT access");
"Cannot perform ENDFILE on a file opened "
"for DIRECT access");
goto done;
}
if (u->flags.access == ACCESS_SEQUENTIAL
&& u->endfile == AFTER_ENDFILE)
{
generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
"Cannot perform ENDFILE on a file already "
"positioned after the EOF marker");
goto done;
}
@ -309,9 +318,49 @@ st_endfile (st_parameter_filepos *fpp)
u->endfile = AFTER_ENDFILE;
if (0 == stell (u->s))
u->flags.position = POSITION_REWIND;
done:
unlock_unit (u);
}
else
{
if (fpp->common.unit < 0)
{
generate_error (&fpp->common, LIBERROR_BAD_OPTION,
"Bad unit number in statement");
return;
}
u = find_or_create_unit (fpp->common.unit);
if (u->s == NULL)
{
/* Open the unit with some default flags. */
st_parameter_open opp;
unit_flags u_flags;
memset (&u_flags, '\0', sizeof (u_flags));
u_flags.access = ACCESS_SEQUENTIAL;
u_flags.action = ACTION_READWRITE;
u_flags.form = FORM_UNSPECIFIED;
u_flags.delim = DELIM_UNSPECIFIED;
u_flags.blank = BLANK_UNSPECIFIED;
u_flags.pad = PAD_UNSPECIFIED;
u_flags.decimal = DECIMAL_UNSPECIFIED;
u_flags.encoding = ENCODING_UNSPECIFIED;
u_flags.async = ASYNC_UNSPECIFIED;
u_flags.round = ROUND_UNSPECIFIED;
u_flags.sign = SIGN_UNSPECIFIED;
u_flags.status = STATUS_UNKNOWN;
u_flags.convert = GFC_CONVERT_NATIVE;
opp.common = fpp->common;
opp.common.flags &= IOPARM_COMMON_MASK;
u = new_unit (&opp, u, &u_flags);
if (u == NULL)
return;
u->endfile = AFTER_ENDFILE;
}
}
done:
unlock_unit (u);
library_end ();
}

24
libgfortran/io/transfer.c

@ -2267,15 +2267,25 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
return;
}
if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL
&& (cf & IOPARM_DT_HAS_REC) != 0)
if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
{
generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
"Record number not allowed for sequential access "
"data transfer");
return;
}
if ((cf & IOPARM_DT_HAS_REC) != 0)
{
generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
"Record number not allowed for sequential access "
"data transfer");
return;
}
if (dtp->u.p.current_unit->endfile == AFTER_ENDFILE)
{
generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
"Sequential READ or WRITE not allowed after "
"EOF marker, possibly use REWIND or BACKSPACE");
return;
}
}
/* Process the ADVANCE option. */
dtp->u.p.advance_status