This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, libgfortran] PR59419 Failing OPEN with FILE='xxx' and IOSTAT creates the file 'xxx'
- From: Jerry DeLisle <jvdelisle at charter dot net>
- To: gfortran <fortran at gcc dot gnu dot org>
- Cc: gcc patches <gcc-patches at gcc dot gnu dot org>
- Date: Sun, 15 Dec 2013 14:14:07 -0800
- Subject: [patch, libgfortran] PR59419 Failing OPEN with FILE='xxx' and IOSTAT creates the file 'xxx'
- Authentication-results: sourceware.org; auth=none
Hi all,
The attached patch fixes the problem by properly exiting when an error has
occurred rather then falling through and creating the file.
The patch also fixes a few other places I found after auditing all calls to
generate error in libgfortran/io.
I will conjure up a test case for this.
I have regression tested on X86-64 Linux. OK for trunk?
Regards,
Jerry
2013-12-15 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.
Index: file_pos.c
===================================================================
--- file_pos.c (revision 205993)
+++ file_pos.c (working copy)
@@ -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)
Index: open.c
===================================================================
--- open.c (revision 205993)
+++ open.c (working copy)
@@ -265,39 +265,39 @@ edit_modes (st_parameter_open *opp, gfc_unit * u,
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, uni
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)
Index: transfer.c
===================================================================
--- transfer.c (revision 205993)
+++ transfer.c (working copy)
@@ -2490,14 +2490,18 @@ data_transfer_init (st_parameter_dt *dtp, int read
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)