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

re PR libfortran/59419 (Failing OPEN with FILE='xxx' and IOSTAT creates the file 'xxx' after revision 196783)

Browse Source 
2013-12-16  Jerry DeLisle  <jvdelisle@gcc.gnu>

	PR libfortran/59419
	* io/file_pos.c (st_rewind): Do proper return after
	generate_error.
	* io/open.c (edit_modes): Move action code inside block that
	checks for library ok. (new_unit): Do cleanup after error.
	(st_open): Do proper return after error.
	* io/transfer.c (data_transfer_init): Likewise.

From-SVN: r206039
This commit is contained in:
Jerry DeLisle 2013-12-17 03:06:04 +00:00
parent 01d9018526
commit 1ede59e4c7
4 changed files with 63 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
libgfortran/ChangeLog
View File

@ -1,3 +1,13 @@
2013-12-16 Jerry DeLisle <jvdelisle@gcc.gnu>
PR libfortran/59419
* io/file_pos.c (st_rewind): Do proper return after
generate_error.
* io/open.c (edit_modes): Move action code inside block that
checks for library ok. (new_unit): Do cleanup after error.
(st_open): Do proper return after error.
* io/transfer.c (data_transfer_init): Likewise.
2013-12-11 Tobias Burnus <burnus@net-b.de>
* config/fpu-387.h (sigill_hdlr, get_fpu_rounding_mode): Emit SSE

6
libgfortran/io/file_pos.c
View File

@ -410,7 +410,11 @@ st_rewind (st_parameter_filepos *fpp)
u->last_record = 0;
if (sseek (u->s, 0, SEEK_SET) < 0)
generate_error (&fpp->common, LIBERROR_OS, NULL);
{
generate_error (&fpp->common, LIBERROR_OS, NULL);
library_end ();
return;
}
/* Set this for compatibilty with g77 for /dev/null. */
if (ssize (u->s) == 0)

77
libgfortran/io/open.c
View File

@ -265,39 +265,39 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
u->flags.round = flags->round;
if (flags->sign != SIGN_UNSPECIFIED)
u->flags.sign = flags->sign;
}
/* Reposition the file if necessary. */
switch (flags->position)
{
case POSITION_UNSPECIFIED:
case POSITION_ASIS:
break;
case POSITION_REWIND:
if (sseek (u->s, 0, SEEK_SET) != 0)
goto seek_error;
u->current_record = 0;
u->last_record = 0;
test_endfile (u);
break;
case POSITION_APPEND:
if (sseek (u->s, 0, SEEK_END) < 0)
goto seek_error;
if (flags->access != ACCESS_STREAM)
u->current_record = 0;
u->endfile = AT_ENDFILE; /* We are at the end. */
break;
seek_error:
generate_error (&opp->common, LIBERROR_OS, NULL);
break;
/* Reposition the file if necessary. */
switch (flags->position)
{
case POSITION_UNSPECIFIED:
case POSITION_ASIS:
break;
case POSITION_REWIND:
if (sseek (u->s, 0, SEEK_SET) != 0)
goto seek_error;
u->current_record = 0;
u->last_record = 0;
test_endfile (u);
break;
case POSITION_APPEND:
if (sseek (u->s, 0, SEEK_END) < 0)
goto seek_error;
if (flags->access != ACCESS_STREAM)
u->current_record = 0;
u->endfile = AT_ENDFILE; /* We are at the end. */
break;
seek_error:
generate_error (&opp->common, LIBERROR_OS, NULL);
break;
}
}
unlock_unit (u);
@ -562,7 +562,10 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
if (flags->position == POSITION_APPEND)
{
if (sseek (u->s, 0, SEEK_END) < 0)
generate_error (&opp->common, LIBERROR_OS, NULL);
{
generate_error (&opp->common, LIBERROR_OS, NULL);
goto cleanup;
}
u->endfile = AT_ENDFILE;
}
@ -852,8 +855,12 @@ st_open (st_parameter_open *opp)
{
u = find_unit (opp->common.unit);
if (u == NULL) /* Negative unit and no NEWUNIT-created unit found. */
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Bad unit number in OPEN statement");
{
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Bad unit number in OPEN statement");
library_end ();
return;
}
}
if (u == NULL)

8
libgfortran/io/transfer.c
View File

@ -2490,14 +2490,18 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
if ((cf & IOPARM_DT_HAS_NAMELIST_NAME) != 0 && dtp->u.p.ionml != NULL)
{
if ((cf & IOPARM_DT_HAS_FORMAT) != 0)
generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
"A format cannot be specified with a namelist");
{
generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
"A format cannot be specified with a namelist");
return;
}
}
else if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
!(cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT)))
{
generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
"Missing format for FORMATTED data transfer");
return;
}
if (is_internal_unit (dtp)