OSDN Git Service

2007-04-27 Jerry DeLisle <jvdelisle@gcc.gnu.org>
authorjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 28 Apr 2007 02:03:21 +0000 (02:03 +0000)
committerjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 28 Apr 2007 02:03:21 +0000 (02:03 +0000)
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

libgfortran/ChangeLog
libgfortran/io/file_pos.c
libgfortran/io/inquire.c
libgfortran/io/io.h
libgfortran/io/transfer.c
libgfortran/io/unit.c

index a884050..983c64f 100644 (file)
@@ -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
index 846dae9..c9034e8 100644 (file)
@@ -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);
     }
 
index 36e43c2..b1f4a14 100644 (file)
@@ -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)
     {
index df00669..1e5a6c9 100644 (file)
@@ -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 *);
index f9f6657..ac5f11b 100644 (file)
@@ -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)
        {
index 2d2c742..7a4000d 100644 (file)
@@ -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;
+}