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

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index a884050c97d87623761fc0472603841300fc1240..983c64ff86b2d32e3129d4793977c8dc926976c8 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,16 @@
+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

diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 846dae932ecd6f018115f60e13f5d6c22dd8910f..c9034e8c8ca71719b8980fa4da7b8a9372732ba1 100644 (file)
--- 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 36e43c29bdf76d2cca4f08e13bdd9e7d3756e252..b1f4a14f6c446820667c094d630d5aa2a0d478bb 100644 (file)
--- 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 df006693b28233e83e0ac89ed307247a3480f38e..1e5a6c9fdbf10847f68a80de12ce0805b3913da4 100644 (file)
--- 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 f9f6657b737e4b281c67deb853872a501471c6f6..ac5f11b40ffc9b0048c096db0644af3e69212f91 100644 (file)
--- 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 2d2c7426cf61f65afde411ee6b471c852ea2616a..7a4000d9fb504c133dd29ee09a8fb85ce2fce673 100644 (file)
--- 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;
+}