Update file position for inquire lazily.

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.

From-SVN: r180703

gcc/testsuite/ChangeLog

@@ -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.

gcc/testsuite/gfortran.dg/inquire_5.f90

@@ -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

libgfortran/ChangeLog

@@ -1,3 +1,13 @@
+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.

libgfortran/io/inquire.c

@@ -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)
+	{
-          {
+	  /* If the position is unspecified, check if we can figure
-             case POSITION_REWIND:
+	     out whether it's at the beginning or end.  */
-               p = "REWIND";
+	  if (u->flags.position == POSITION_UNSPECIFIED)
-               break;
+	    {
-             case POSITION_APPEND:
+	      gfc_offset cur = stell (u->s);
-               p = "APPEND";
+	      if (cur == 0)
-               break;
+		u->flags.position = POSITION_REWIND;
-             case POSITION_ASIS:
+	      else if (cur != -1 && (ssize (u->s) == cur))
-               p = "ASIS";
+		u->flags.position = POSITION_APPEND;
-               break;
+	    }
-             default:
+	  switch (u->flags.position)
-               /* if not direct access, it must be
+	    {
-                  either REWIND, APPEND, or ASIS.
+	    case POSITION_REWIND:
-                  ASIS seems to be the best default */
+	      p = "REWIND";
-               p = "ASIS";
+	      break;
-               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);
     }
 

libgfortran/io/io.h

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

libgfortran/io/transfer.c

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

libgfortran/io/unit.c

@@ -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.  */