OSDN Git Service

Update file position for inquire lazily.
authorjb <jb@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 31 Oct 2011 14:59:19 +0000 (14:59 +0000)
committerjb <jb@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 31 Oct 2011 14:59:19 +0000 (14:59 +0000)
libgfortran ChangeLog:

2011-10-31  Janne Blomqvist  <jb@gcc.gnu.org>

* io/inquire.c (inquire_via_unit): Check whether we're at the
beginning or end if the position is unspecified. If the position
is not one of the 3 standard ones, return unspecified.
* io/io.h (update_position): Remove prototype.
* io/transfer.c (next_record): Set the position to unspecified,
letting inquire figure it out more exactly when needed.
* io/unit.c (update_position): Remove function.

testsuite ChangeLog:

2011-10-31  Janne Blomqvist  <jb@gcc.gnu.org>

* gfortran.dg/inquire_5.f90: Update testcase to match the standard
and current implementation.

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

gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/inquire_5.f90
libgfortran/ChangeLog
libgfortran/io/inquire.c
libgfortran/io/io.h
libgfortran/io/transfer.c
libgfortran/io/unit.c

index a432ab8..c3a1f0f 100644 (file)
@@ -1,3 +1,8 @@
+2011-10-31  Janne Blomqvist  <jb@gcc.gnu.org>
+
+       * gfortran.dg/inquire_5.f90: Update testcase to match the standard
+       and current implementation.
+
 2011-10-31  Paul Brook  <paul@codesourcery.com>
 
        * gcc.dg/constructor-1.c: New test.
index fe107a1..2be3a34 100644 (file)
@@ -1,11 +1,10 @@
 ! { dg-do run { target fd_truncate } }
-! { dg-options "-std=legacy" }
 !
 ! pr19314 inquire(..position=..) segfaults
 ! test by Thomas.Koenig@online.de
 !         bdavis9659@comcast.net
       implicit none
-      character*20 chr
+      character(len=20) chr
       open(7,STATUS='SCRATCH')
       inquire(7,position=chr)
       if (chr.NE.'ASIS') CALL ABORT
@@ -31,7 +30,7 @@
       write(7,*)'this is another record'
       backspace(7)
       inquire(7,position=chr)
-      if (chr.NE.'ASIS') CALL ABORT
+      if (chr .NE. 'UNSPECIFIED') CALL ABORT
       rewind(7)
       inquire(7,position=chr)
       if (chr.NE.'REWIND') CALL ABORT
index 68ff646..cbad61a 100644 (file)
@@ -1,5 +1,15 @@
 2011-10-31  Janne Blomqvist  <jb@gcc.gnu.org>
 
+       * io/inquire.c (inquire_via_unit): Check whether we're at the
+       beginning or end if the position is unspecified. If the position
+       is not one of the 3 standard ones, return unspecified.
+       * io/io.h (update_position): Remove prototype.
+       * io/transfer.c (next_record): Set the position to unspecified,
+       letting inquire figure it out more exactly when needed.
+       * io/unit.c (update_position): Remove function.
+
+2011-10-31  Janne Blomqvist  <jb@gcc.gnu.org>
+
        * io/unix.h (struct stream): Add size function pointer.
        (ssize): New inline function.
        (file_length): Remove prototype.
index 252f29f..fb525ca 100644 (file)
@@ -418,24 +418,36 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
       if (u == NULL || u->flags.access == ACCESS_DIRECT)
         p = undefined;
       else
-        switch (u->flags.position)
-          {
-             case POSITION_REWIND:
-               p = "REWIND";
-               break;
-             case POSITION_APPEND:
-               p = "APPEND";
-               break;
-             case POSITION_ASIS:
-               p = "ASIS";
-               break;
-             default:
-               /* if not direct access, it must be
-                  either REWIND, APPEND, or ASIS.
-                  ASIS seems to be the best default */
-               p = "ASIS";
-               break;
-          }
+       {
+         /* If the position is unspecified, check if we can figure
+            out whether it's at the beginning or end.  */
+         if (u->flags.position == POSITION_UNSPECIFIED)
+           {
+             gfc_offset cur = stell (u->s);
+             if (cur == 0)
+               u->flags.position = POSITION_REWIND;
+             else if (cur != -1 && (ssize (u->s) == cur))
+               u->flags.position = POSITION_APPEND;
+           }
+         switch (u->flags.position)
+           {
+           case POSITION_REWIND:
+             p = "REWIND";
+             break;
+           case POSITION_APPEND:
+             p = "APPEND";
+             break;
+           case POSITION_ASIS:
+             p = "ASIS";
+             break;
+           default:
+             /* If the position has changed and is not rewind or
+                append, it must be set to a processor-dependent
+                value.  */
+             p = "UNSPECIFIED";
+             break;
+           }
+       }
       cf_strcpy (iqp->position, iqp->position_len, p);
     }
 
index 37353d7..23f07ca 100644 (file)
@@ -608,9 +608,6 @@ internal_proto(get_unit);
 extern void unlock_unit (gfc_unit *);
 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);
 
index 26263ae..062f80e 100644 (file)
@@ -3343,9 +3343,10 @@ next_record (st_parameter_dt *dtp, int done)
 
   if (!is_stream_io (dtp))
     {
-      /* Keep position up to date for INQUIRE */
+      /* Since we have changed the position, set it to unspecified so
+        that INQUIRE(POSITION=) knows it needs to look into it.  */
       if (done)
-       update_position (dtp->u.p.current_unit);
+       dtp->u.p.current_unit->flags.position = POSITION_UNSPECIFIED;
 
       dtp->u.p.current_unit->current_record = 0;
       if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
index 1d36214..b4d10cd 100644 (file)
@@ -706,26 +706,6 @@ close_units (void)
 }
 
 
-/* update_position()-- Update the flags position for later use by inquire.  */
-
-void
-update_position (gfc_unit *u)
-{
-  /* If unit is not seekable, this makes no sense (and the standard is
-     silent on this matter), and thus we don't change the position for
-     a non-seekable file.  */
-  gfc_offset cur = stell (u->s);
-  if (cur == -1)
-    return;
-  else if (cur == 0)
-    u->flags.position = POSITION_REWIND;
-  else if (ssize (u->s) == cur)
-    u->flags.position = POSITION_APPEND;
-  else
-    u->flags.position = POSITION_ASIS;
-}
-
-
 /* High level interface to truncate a file, i.e. flush format buffers,
    and generate an error or set some flags.  Just like POSIX
    ftruncate, returns 0 on success, -1 on failure.  */