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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f764fdde3296f5ec11792a9c016552e0559b054b..fb28b4b79034cc67360cad0112c8ab74fc669890 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/inquire_5.f90 b/gcc/testsuite/gfortran.dg/inquire_5.f90
new file mode 100644 (file)
index 0000000..0daa579
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_5.f90
@@ -0,0 +1,35 @@
+! { 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

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index d6bcb8d9cbb0caa685b806c5f9613c0af604e95e..9f7e3789cd659faa3b6569850fd64aba001cb49f 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+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

diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index 4127f7081dd19db8168d30f8c004e5a8ccf0637c..20fa8b3dd7bcfc333b59aa021eb53796b7c4a5c7 100644 (file)
--- a/libgfortran/io/inquire.c
+++ b/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)

diff --git a/libgfortran/io/rewind.c b/libgfortran/io/rewind.c
index d5ea31e6468d556661aeade054dd5ccb529a35b8..f0b0e90e45449fddb9e003b94d0b7e8b2ad4e74e 100644 (file)
--- a/libgfortran/io/rewind.c
+++ b/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 ();

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 73ae853fc87da387b5eb6df41184ae7967a35ede..114ed92abb951b2d28208aff727e99a884e00112 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/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)
    {