2007-04-27 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR libfortran/31532
	* io/file_pos.c (st_backspace): Set flags.position for end of file
	condition and use new function update_position.
	(st_endfile): Use new function update_position.
	* io/io.h: Add prototype for new function.
	* io/inquire.c (inquire_via_unit): If not direct access, set NEXTREC
	to zero.
	* io/unit.c (update_position): New function to update position info
	used by inquire.
	* io/transfer.c (next_record): Fix typo and use new function.


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

5 files changed, 35 insertions, 4 deletions

diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 846dae932ec..c9034e8c8ca 100644
--- a/libgfortran/io/file_pos.c
+++ b/libgfortran/io/file_pos.c
@@ -213,13 +213,17 @@ st_backspace (st_parameter_filepos *fpp)
   if (u->endfile == AFTER_ENDFILE)
     {
       u->endfile = AT_ENDFILE;
+      u->flags.position = POSITION_APPEND;
       flush (u->s);
       struncate (u->s);
     }
   else
     {
       if (file_position (u->s) == 0)
-	goto done;		/* Common special case */
+	{
+	  u->flags.position = POSITION_REWIND;
+	  goto done;		/* Common special case */
+	}
 
       if (u->mode == WRITING)
 	{
@@ -233,6 +237,7 @@ st_backspace (st_parameter_filepos *fpp)
       else
 	unformatted_backspace (fpp, u);
 
+      update_position (u);
       u->endfile = NO_ENDFILE;
       u->current_record = 0;
       u->bytes_left = 0;
@@ -271,6 +276,7 @@ st_endfile (st_parameter_filepos *fpp)
       flush (u->s);
       struncate (u->s);
       u->endfile = AFTER_ENDFILE;
+      update_position (u);
       unlock_unit (u);
     }
 
diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index 36e43c29bdf..b1f4a14f6c4 100644
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -152,7 +152,13 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
     *iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0;
 
   if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
-    *iqp->nextrec = (u != NULL) ? u->last_record + 1 : 0;
+    {
+      /* This only makes sense in the context of DIRECT access.  */
+      if (u != NULL && u->flags.access == ACCESS_DIRECT)
+	*iqp->nextrec = u->last_record + 1;
+      else
+	*iqp->nextrec = 0;
+    }
 
   if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
     {
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index df006693b28..1e5a6c9fdbf 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -693,6 +693,9 @@ internal_proto(get_unit);
 extern void unlock_unit (gfc_unit *);
 internal_proto(unlock_unit);
 
+extern void update_position (gfc_unit *);
+internal_proto(update_position);
+
 /* 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 f9f6657b737..ac5f11b40ff 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2546,8 +2546,10 @@ next_record (st_parameter_dt *dtp, int done)
 
   if (!is_stream_io (dtp))
     {
-      /* keep position up to date for INQUIRE */
-      dtp->u.p.current_unit->flags.position = POSITION_ASIS;
+      /* Keep position up to date for INQUIRE */
+      if (done)
+	update_position (dtp->u.p.current_unit);
+
       dtp->u.p.current_unit->current_record = 0;
       if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
 	{
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 2d2c7426cf6..7a4000d9fb5 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -678,3 +678,17 @@ close_units (void)
     close_unit_1 (unit_root, 1);
   __gthread_mutex_unlock (&unit_lock);
 }
+
+
+/* update_position()-- Update the flags position for later use by inquire.  */
+
+void
+update_position (gfc_unit *u)
+{
+  if (file_position (u->s) == 0)
+    u->flags.position = POSITION_REWIND;
+  else if (file_length (u->s) == file_position (u->s))
+    u->flags.position = POSITION_APPEND;
+  else
+    u->flags.position = POSITION_ASIS;
+}