diff mbox

[libgfortran] PR59419 Failing OPEN with FILE='xxx' and IOSTAT creates the file 'xxx'

Message ID 52AE29AF.1090106@charter.net
State New
Headers show

Commit Message

Jerry DeLisle Dec. 15, 2013, 10:14 p.m. UTC 
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.

Comments

Tobias Burnus Dec. 16, 2013, 7:07 a.m. UTC | #1 
Am 15.12.2013 23:14, schrieb Jerry DeLisle:
> 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.
Thanks for both.

> I have regression tested on X86-64 Linux.  OK for trunk?

OK.

Tobias

> 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.
diff mbox

Patch

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)