FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

PR libfortran/43605 FTELL intrinsic, take 2.

Browse source 
Co-Authored-By: Dominique d'Humieres <dominiq@lps.ens.fr>

From-SVN: r157932
This commit is contained in:
Janne Blomqvist 2010-04-01 23:51:45 +03:00
parent abfb38d739
commit b879c108b2
4 changed files with 39 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,9 @@
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

11
gcc/testsuite/gfortran.dg/ftell_3.f90
View file

@ -1,6 +1,7 @@
! { 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
@ -15,5 +16,13 @@ program ftell_3
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

7
libgfortran/ChangeLog
View file

@ -1,3 +1,10 @@
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.

31
libgfortran/io/intrinsics.c
View file

@ -260,19 +260,27 @@ fseek_sub (int * unit, GFC_IO_INT * offset, int * whence, int * status)
/* 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) \
@ -281,14 +289,7 @@ PREFIX(ftell) (int * unit)
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)