From 08810e5257936014e242527cdbb2de6beddf24e8 Mon Sep 17 00:00:00 2001 From: Janne Blomqvist Date: Mon, 31 Oct 2011 16:59:19 +0200 Subject: [PATCH] Update file position for inquire lazily. libgfortran ChangeLog: 2011-10-31 Janne Blomqvist * 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 * gfortran.dg/inquire_5.f90: Update testcase to match the standard and current implementation. From-SVN: r180703 --- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/inquire_5.f90 | 5 ++- libgfortran/ChangeLog | 10 ++++++ libgfortran/io/inquire.c | 48 +++++++++++++++---------- libgfortran/io/io.h | 3 -- libgfortran/io/transfer.c | 5 +-- libgfortran/io/unit.c | 20 ----------- 7 files changed, 50 insertions(+), 46 deletions(-) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a432ab85164..c3a1f0fba43 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-10-31 Janne Blomqvist + + * gfortran.dg/inquire_5.f90: Update testcase to match the standard + and current implementation. + 2011-10-31 Paul Brook * gcc.dg/constructor-1.c: New test. diff --git a/gcc/testsuite/gfortran.dg/inquire_5.f90 b/gcc/testsuite/gfortran.dg/inquire_5.f90 index fe107a19863..2be3a34c3f3 100644 --- a/gcc/testsuite/gfortran.dg/inquire_5.f90 +++ b/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 diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 68ff646e4b6..cbad61af460 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,13 @@ +2011-10-31 Janne Blomqvist + + * 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 * io/unix.h (struct stream): Add size function pointer. diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c index 252f29f0aef..fb525caf863 100644 --- a/libgfortran/io/inquire.c +++ b/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) - { - 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); } diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 37353d742e8..23f07cae548 100644 --- a/libgfortran/io/io.h +++ b/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); diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 26263aef0ae..062f80efec4 100644 --- a/libgfortran/io/transfer.c +++ b/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) diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index 1d36214b1cd..b4d10cdbf11 100644 --- a/libgfortran/io/unit.c +++ b/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. */