+2010-04-01 Janne Blomqvist <jb@gcc.gnu.org>
+ Dominique d'Humieres <dominiq@lps.ens.fr>
+
+ PR libfortran/43605
+ * gfortran.dg/ftell_3.f90: Enhance test case by reading more.
+
2010-04-01 Dodji Seketeli <dodji@redhat.com>
PR debug/43325
! { dg-do run }
! PR43605 FTELL intrinsic returns incorrect position
-! Contributed by Janne Blomqvist and Manfred Schwarb
+! Contributed by Janne Blomqvist, Manfred Schwarb
+! and Dominique d'Humieres.
program ftell_3
integer :: i
character(len=99) :: buffer
if(i /= 7) then
call abort()
end if
+ read(10,'(a)') buffer
+ if (trim(buffer) /= "789") then
+ call abort()
+ end if
+ call ftell(10,i)
+ if (i /= 11) then
+ call abort()
+ end if
close(10)
end program ftell_3
+2010-04-01 Janne Blomqvist <jb@gcc.gnu.org>
+
+ PR libfortran/43605
+ * io/intrinsics.c (gf_ftell): New function, seek to correct offset.
+ (ftell): Call gf_ftell.
+ (FTELL_SUB): Likewise.
+
2010-04-01 Paul Thomas <pault@gcc.gnu.org>
* io/transfer.c : Update copyright.
/* FTELL intrinsic */
+static gfc_offset
+gf_ftell (int unit)
+{
+ gfc_unit * u = find_unit (unit);
+ if (u == NULL)
+ return -1;
+ int pos = fbuf_reset (u);
+ if (pos != 0)
+ sseek (u->s, pos, SEEK_CUR);
+ gfc_offset ret = stell (u->s);
+ unlock_unit (u);
+ return ret;
+}
+
extern size_t PREFIX(ftell) (int *);
export_proto_np(PREFIX(ftell));
size_t
PREFIX(ftell) (int * unit)
{
- gfc_unit * u = find_unit (*unit);
- gfc_offset ret;
- if (u == NULL)
- return ((size_t) -1);
- ret = stell (u->s) + fbuf_reset (u);
- unlock_unit (u);
- return ret;
+ return gf_ftell (*unit);
}
#define FTELL_SUB(kind) \
void \
ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \
{ \
- gfc_unit * u = find_unit (*unit); \
- if (u == NULL) \
- *offset = -1; \
- else \
- { \
- *offset = stell (u->s) + fbuf_reset (u); \
- unlock_unit (u); \
- } \
+ *offset = gf_ftell (*unit); \
}
FTELL_SUB(1)