re PR libfortran/31532 (INQUIRE(...,POSITION=...) not standard conforming)

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.

From-SVN: r124252

libgfortran/ChangeLog

+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.
+
 2007-04-25  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR libfortran/31299

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);
     }
 

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)
     {

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 *);

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)
 	{

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;
+}