re PR libfortran/19314 (inquire(position=) segfaults at runtime)

2004-01-22  Bud Davis  <bdavis9659@comcast.net>

        PR fortran/19314
        * io/inquire.c(inquire_via_unit): implement POSITION=.
        * io/transfer.c(next_record): update position for
        INQUIRE.
        * io/rewind.c(st_rewind): update position for
        INQUIRE.

        * gfortran.dg/inquire_5.f90: New test.

From-SVN: r94060

gcc/testsuite/ChangeLog

+2005-01-22  Bud Davis  <bdavis9659@comcast.net>
+
+	PR fortran/19314
+	* gfortran.dg/inquire_5.f90: New test.
+
 2005-01-22  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
 
 	PR c/18809

gcc/testsuite/gfortran.dg/inquire_5.f90

+! { dg-do run }
+! pr19314 inquire(..position=..) segfaults
+! test by Thomas.Koenig@online.de
+!         bdavis9659@comcast.net
+      implicit none
+      character*20 chr
+      open(7,STATUS='SCRATCH')
+      inquire(7,position=chr)
+      if (chr.NE.'ASIS') CALL ABORT
+      close(7)
+      open(7,STATUS='SCRATCH',ACCESS='DIRECT',RECL=100)
+      inquire(7,position=chr)
+      if (chr.NE.'UNDEFINED') CALL ABORT
+      close(7)
+      open(7,STATUS='SCRATCH',POSITION='REWIND')
+      inquire(7,position=chr)
+      if (chr.NE.'REWIND') CALL ABORT
+      close(7)
+      open(7,STATUS='SCRATCH',POSITION='ASIS')
+      inquire(7,position=chr)
+      if (chr.NE.'ASIS') CALL ABORT
+      close(7)
+      open(7,STATUS='SCRATCH',POSITION='APPEND')
+      inquire(7,position=chr)
+      if (chr.NE.'APPEND') CALL ABORT
+      close(7)
+      open(7,STATUS='SCRATCH',POSITION='REWIND')
+      write(7,*)'this is a record written to the file'
+      inquire(7,position=chr)
+      if (chr.NE.'ASIS') CALL ABORT
+      rewind(7)
+      inquire(7,position=chr)
+      if (chr.NE.'REWIND') CALL ABORT
+      close(7)
+      end

libgfortran/ChangeLog

+2004-01-22  Bud Davis  <bdavis9659@comcast.net>
+
+	PR fortran/19314
+	* io/inquire.c(inquire_via_unit): implement POSITION=.
+	* io/transfer.c(next_record): update position for 
+	INQUIRE.
+	* io/rewind.c(st_rewind): update position for
+	INQUIRE.
+
 2004-01-16  Bud Davis  <bdavis9659@comcast.net>
 
 	PR fortran/18778

libgfortran/io/inquire.c

@@ -166,13 +166,27 @@ inquire_via_unit (gfc_unit * u)
   if (ioparm.position != NULL)
     {
       if (u == NULL || u->flags.access == ACCESS_DIRECT)
-	p = undefined;
+        p = undefined;
       else
-	{
-	  p = NULL;		/* TODO: Try to decode what the standard says... */
-	}
-
-      cf_strcpy (ioparm.blank, ioparm.blank_len, p);
+        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;
+          }
+      cf_strcpy (ioparm.position, ioparm.position_len, p);
     }
 
   if (ioparm.action != NULL)

libgfortran/io/rewind.c

@@ -66,6 +66,8 @@ st_rewind (void)
 	  u->current_record = 0;
 	  test_endfile (u);
 	}
+      /* update position for INQUIRE */
+      u->flags.position = POSITION_REWIND;
     }
 
   library_end ();

libgfortran/io/transfer.c

@@ -1363,6 +1363,9 @@ next_record (int done)
   else
     next_record_w (done);
 
+  /* keep position up to date for INQUIRE */
+  current_unit->flags.position = POSITION_ASIS;
+
   current_unit->current_record = 0;
   if (current_unit->flags.access == ACCESS_DIRECT)
    {