From e76a3fde81380ce422994e1a0fb21322d2268341 Mon Sep 17 00:00:00 2001 From: Janne Blomqvist Date: Thu, 1 Apr 2010 19:22:57 +0300 Subject: [PATCH] PR libfortran/43605 Fix FTELL for formatted files Co-Authored-By: Manfred Schwarb From-SVN: r157914 --- gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gfortran.dg/ftell_3.f90 | 19 +++++++++++++++++++ libgfortran/ChangeLog | 6 ++++++ libgfortran/io/intrinsics.c | 10 +++++----- 4 files changed, 36 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/ftell_3.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c182186e61f..8c48a0b9040 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-04-01 Janne Blomqvist + Manfred Schwarb + + PR libfortran/43605 + * gfortran.dg/ftell_3.f90: New test. + 2010-04-01 Richard Guenther PR middle-end/43614 diff --git a/gcc/testsuite/gfortran.dg/ftell_3.f90 b/gcc/testsuite/gfortran.dg/ftell_3.f90 new file mode 100644 index 00000000000..1981678d41c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ftell_3.f90 @@ -0,0 +1,19 @@ +! { dg-do run } +! PR43605 FTELL intrinsic returns incorrect position +! Contributed by Janne Blomqvist and Manfred Schwarb +program ftell_3 + integer :: i + character(len=99) :: buffer + open(10, form='formatted', status='scratch', position='rewind') + write(10, '(a)') '123456' + write(10, '(a)') '789' + write(10, '(a)') 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' + write(10, '(a)') 'DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD' + rewind(10) + read(10, '(a)') buffer + call ftell(10, i) + if(i /= 7) then + call abort() + end if + close(10) +end program ftell_3 diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 2385b64483c..495683c5b22 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,9 @@ +2010-04-01 Janne Blomqvist + + PR libfortran/43605 + * io/intrinsics.c (ftell): Reset fbuf, correct offset. + (FTELL_SUB): Likewise. + 2010-03-29 Jerry DeLisle PR libfortran/43265 diff --git a/libgfortran/io/intrinsics.c b/libgfortran/io/intrinsics.c index 9428b759d15..4beb0135c86 100644 --- a/libgfortran/io/intrinsics.c +++ b/libgfortran/io/intrinsics.c @@ -1,8 +1,8 @@ /* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH FTELL, TTYNAM and ISATTY intrinsics. - Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Copyright (C) 2005, 2007, 2009, 2010 Free Software Foundation, Inc. -This file is part of the GNU Fortran 95 runtime library (libgfortran). +This file is part of the GNU Fortran runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public @@ -267,10 +267,10 @@ size_t PREFIX(ftell) (int * unit) { gfc_unit * u = find_unit (*unit); - size_t ret; + gfc_offset ret; if (u == NULL) return ((size_t) -1); - ret = (size_t) stell (u->s); + ret = stell (u->s) + fbuf_reset (u); unlock_unit (u); return ret; } @@ -286,7 +286,7 @@ PREFIX(ftell) (int * unit) *offset = -1; \ else \ { \ - *offset = stell (u->s); \ + *offset = stell (u->s) + fbuf_reset (u); \ unlock_unit (u); \ } \ }