2007-12-13 Thomas Koenig <tkoenig@gcc.gnu.org>

	PR libfortran/34370
	PR libfortran/34323
	PR libfortran/34405
	* io/io.h:  Add previous_nonadvancing_write to gfc_unit.
	Add prototype for finish_last_advance_record.
	* io/file_pos.c (st_backspace):  Generate error if backspace is
	attempted for direct access or unformatted stream.
	If there are bytes left from a previous ADVANCE="no", write
	them out before performing the backspace.
	(st_endfile):  Generate error if endfile is attempted for
	direct access.
	If there are bytes left from a previous ADVANCE="no", write
	them out before performing the endfile.
	(st_rewind):  Generate error if rewind is attempted for
	direct access.
	* unit.c (close_unit_1):  Move functionality to write
	previously written bytes to...
	(finish_last_advance_record):  ... here.
	* transfer.c (data_transfer_init):  If reading, reset
	previous_nonadvancing_write.
	(finalize_transfer):  Set the previous_noadvancing_write
	flag if we are writing and ADVANCE="no" was specified.
	Only call next_record() if advance="no" wasn't specified.

2007-12-13  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/34370
	PR libfortran/34323
	PR libfortran/34405
	* gfortran.dg/advance_6.f90:  New test case.
	* gfortran.dg/direct_io_7.f90:  New test case.
	* gfortran.dg/streamio_13.f90:  New test case.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130912 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 114 insertions, 28 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 12969af81d8..d9706df3ab1 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,29 @@
+2007-12-13  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR libfortran/34370
+	PR libfortran/34323
+	PR libfortran/34405
+	* io/io.h:  Add previous_nonadvancing_write to gfc_unit.
+	Add prototype for finish_last_advance_record.
+	* io/file_pos.c (st_backspace):  Generate error if backspace is
+	attempted for direct access or unformatted stream.
+	If there are bytes left from a previous ADVANCE="no", write
+	them out before performing the backspace.
+	(st_endfile):  Generate error if endfile is attempted for
+	direct access.
+	If there are bytes left from a previous ADVANCE="no", write
+	them out before performing the endfile.
+	(st_rewind):  Generate error if rewind is attempted for
+	direct access.
+	* unit.c (close_unit_1):  Move functionality to write
+	previously written bytes to...
+	(finish_last_advance_record):  ... here.
+	* transfer.c (data_transfer_init):  If reading, reset
+	previous_nonadvancing_write.
+	(finalize_transfer):  Set the previous_noadvancing_write
+	flag if we are writing and ADVANCE="no" was specified.
+	Only call next_record() if advance="no" wasn't specified.
+
 2007-12-13  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/34427
diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 96e5e243787..94e29899fb1 100644
--- a/libgfortran/io/file_pos.c
+++ b/libgfortran/io/file_pos.c
@@ -199,12 +199,22 @@ st_backspace (st_parameter_filepos *fpp)
       goto done;
     }
 
-  /* Ignore direct access.  Non-advancing I/O is only allowed for formatted
-     sequential I/O and the next direct access transfer repositions the file 
-     anyway.  */
+  /* Direct access is prohibited, and so is unformatted stream access.  */
 
-  if (u->flags.access == ACCESS_DIRECT || u->flags.access == ACCESS_STREAM)
-    goto done;
+
+  if (u->flags.access == ACCESS_DIRECT)
+    {
+      generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
+		      "Cannot BACKSPACE a file opened for DIRECT access");
+      goto done;
+    }
+
+    if (u->flags.access == ACCESS_STREAM && u->flags.form == FORM_UNFORMATTED)
+      {
+	generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
+			"Cannot BACKSPACE an unformatted stream file");
+	goto done;
+      }
 
   /* Check for special cases involving the ENDFILE record first.  */
 
@@ -224,6 +234,15 @@ st_backspace (st_parameter_filepos *fpp)
 
       if (u->mode == WRITING)
 	{
+	  /* If there are previously written bytes from a write with
+	     ADVANCE="no", add a record marker before performing the
+	     BACKSPACE.  */
+
+	  if (u->previous_nonadvancing_write)
+	    finish_last_advance_record (u);
+
+	  u->previous_nonadvancing_write = 0;
+
 	  flush (u->s);
 	  struncate (u->s);
 	  u->mode = READING;
@@ -261,6 +280,22 @@ st_endfile (st_parameter_filepos *fpp)
   u = find_unit (fpp->common.unit);
   if (u != NULL)
     {
+      if (u->flags.access == ACCESS_DIRECT)
+	{
+	  generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
+			  "Cannot perform ENDFILE on a file opened"
+			  " for DIRECT access");
+	  goto done;
+	}
+
+      /* If there are previously written bytes from a write with ADVANCE="no",
+	 add a record marker before performing the ENDFILE.  */
+
+      if (u->previous_nonadvancing_write)
+	finish_last_advance_record (u);
+
+      u->previous_nonadvancing_write = 0;
+
       if (u->current_record)
 	{
 	  st_parameter_dt dtp;
@@ -274,6 +309,7 @@ st_endfile (st_parameter_filepos *fpp)
       struncate (u->s);
       u->endfile = AFTER_ENDFILE;
       update_position (u);
+    done:
       unlock_unit (u);
     }
 
@@ -299,6 +335,14 @@ st_rewind (st_parameter_filepos *fpp)
 			"Cannot REWIND a file opened for DIRECT access");
       else
 	{
+	  /* If there are previously written bytes from a write with ADVANCE="no",
+	     add a record marker before performing the ENDFILE.  */
+
+	  if (u->previous_nonadvancing_write)
+	    finish_last_advance_record (u);
+
+	  u->previous_nonadvancing_write = 0;
+
 	  /* Flush the buffers.  If we have been writing to the file, the last
 	       written record is the last record in the file, so truncate the
 	       file now.  Reset to read mode so two consecutive rewind
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 602f7b19b13..688a9cbbdc8 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -451,7 +451,8 @@ typedef struct gfc_unit
   struct gfc_unit *left, *right;
   int priority;
 
-  int read_bad, current_record, saved_pos;
+  int read_bad, current_record, saved_pos, previous_nonadvancing_write;
+
   enum
   { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
   endfile;
@@ -692,6 +693,9 @@ internal_proto(unlock_unit);
 extern void update_position (gfc_unit *);
 internal_proto(update_position);
 
+extern void finish_last_advance_record (gfc_unit *u);
+internal_proto (finish_last_advance_record);
+
 /* open.c */
 
 extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 05711a06015..5dddcd31481 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -1891,6 +1891,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
 
   if (read_flag)
     {
+      dtp->u.p.current_unit->previous_nonadvancing_write = 0;
+
       if ((cf & IOPARM_EOR) != 0 && dtp->u.p.advance_status != ADVANCE_NO)
 	{
 	  generate_error (&dtp->common, LIBERROR_MISSING_OPTION,
@@ -2644,9 +2646,14 @@ finalize_transfer (st_parameter_dt *dtp)
       return;
     }
 
+  if (dtp->u.p.mode == WRITING)
+    dtp->u.p.current_unit->previous_nonadvancing_write
+      = dtp->u.p.advance_status == ADVANCE_NO;
+
   if (is_stream_io (dtp))
     {
-      if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
+      if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED
+	  && dtp->u.p.advance_status != ADVANCE_NO)
 	next_record (dtp, 1);
 
       if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index a293baba077..b81f4cce4d8 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -581,27 +581,8 @@ close_unit_1 (gfc_unit *u, int locked)
 
   /* If there are previously written bytes from a write with ADVANCE="no"
      Reposition the buffer before closing.  */
-  if (u->saved_pos > 0)
-    {
-      char *p;
-
-      p = salloc_w (u->s, &u->saved_pos);
-
-      if (!(u->unit_number == options.stdout_unit
-	    || u->unit_number == options.stderr_unit))
-	{
-	  size_t len;
-
-	  const char crlf[] = "\r\n";
-#ifdef HAVE_CRLF
-	  len = 2;
-#else
-	  len = 1;
-#endif
-	  if (swrite (u->s, &crlf[2-len], &len) != 0)
-	    os_error ("Close after ADVANCE_NO failed");
-	}
-    }
+  if (u->previous_nonadvancing_write)
+    finish_last_advance_record (u);
 
   rc = (u->s == NULL) ? 0 : sclose (u->s) == FAILURE;
 
@@ -718,3 +699,27 @@ filename_from_unit (int n)
     return (char *) NULL;
 }
 
+void
+finish_last_advance_record (gfc_unit *u)
+{
+  char *p;
+
+  if (u->saved_pos > 0)
+    p = salloc_w (u->s, &u->saved_pos);
+
+  if (!(u->unit_number == options.stdout_unit
+	|| u->unit_number == options.stderr_unit))
+    {
+      size_t len;
+
+      const char crlf[] = "\r\n";
+#ifdef HAVE_CRLF
+      len = 2;
+#else
+      len = 1;
+#endif
+      if (swrite (u->s, &crlf[2-len], &len) != 0)
+	os_error ("Completing record after ADVANCE_NO failed");
+    }
+}
+