From b3b0377bb577cc90253053fbb90ef6bd6d668d4d Mon Sep 17 00:00:00 2001
From: bdavis <bdavis@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Sat, 22 Jan 2005 03:51:12 +0000
Subject: [PATCH] 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@94060 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/testsuite/ChangeLog | 5 ++++
gcc/testsuite/gfortran.dg/inquire_5.f90 | 35 +++++++++++++++++++++++++
libgfortran/ChangeLog | 9 +++++++
libgfortran/io/inquire.c | 26 +++++++++++++-----
libgfortran/io/rewind.c | 2 ++
libgfortran/io/transfer.c | 3 +++
6 files changed, 74 insertions(+), 6 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/inquire_5.f90
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f764fdde3296..fb28b4b79034 100644
--- 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
index 000000000000..0daa579d1b67
--- /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 d6bcb8d9cbb0..9f7e3789cd65 100644
--- 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 4127f7081dd1..20fa8b3dd7bc 100644
--- 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 d5ea31e6468d..f0b0e90e4544 100644
--- 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 73ae853fc87d..114ed92abb95 100644
--- 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)
{
--
GitLab