Hi,
libgfortran maintains a position flag which is used by the
INQUIRE(POSITION=...) statement. Currently we update this flag after
every IO statement. For unbuffered IO this is somewhat tedious, as
figuring out whether we're at the beginning of a file or the end
requires at least two syscalls. The attached patch moves this checking
to the inquire implementation, which is certainly less frequently
invoked than READ or WRITE.
Also, I think I've found a small standards conformance bug. From F2008
(N1830) 9.10.2.23 (page 256): "... ASIS if the connection was opened
without changing its position." and "If the file has been repositioned
since the connection, the scalar-default-char-variable
is assigned a processor-dependent value, which shall not be REWIND
unless the file is positioned at its initial
point and shall not be APPEND unless the file is positioned so that its
endfile record is the next record or at its
terminal point if it has no endfile record.
"
If my understanding of the above is correct, returning ASIS is
incorrent unless the position is unchanged since the OPEN statement.
Currently we return ASIS by default if it's neither REWIND nor APPEND.
So the patch changes the implementation to return the
processor-dependent value UNSPECIFIED in this case.
Regtested on x86_64-unknown-linux-gnu, Ok for trunk?
2011-10-18 Janne Blomqvist <j...@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-18 Janne Blomqvist <j...@gcc.gnu.org>
* gfortran.dg/inquire_5.f90: Update testcase to match the standard
and current implementation.
--
Janne Blomqvist
diff --git a/gcc/testsuite/gfortran.dg/inquire_5.f90 b/gcc/testsuite/gfortran.dg/inquire_5.f90
index fe107a1..064f96d 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.koe...@online.de
! bdavis9...@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,8 @@
write(7,*)'this is another record'
backspace(7)
inquire(7,position=chr)
- if (chr.NE.'ASIS') CALL ABORT
+ if (chr.eq.'ASIS' .or. chr .eq. 'REWIND' &
+ .or. chr .eq. 'APPEND') CALL ABORT
rewind(7)
inquire(7,position=chr)
if (chr.NE.'REWIND') CALL ABORT
diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index 252f29f..fb525ca 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 37353d7..23f07ca 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 26263ae..062f80e 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 1d36214..b4d10cd 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. */
