PR libfortran/43605 FTELL intrinsic, take 2.

Co-Authored-By: Dominique d'Humieres <dominiq@lps.ens.fr>
From-SVN: r157932

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8cefbf4..16b901b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/ftell_3.f90 b/gcc/testsuite/gfortran.dg/ftell_3.f90
index 1981678..c16afe8 100644 (file)
--- a/gcc/testsuite/gfortran.dg/ftell_3.f90
+++ b/gcc/testsuite/gfortran.dg/ftell_3.f90
@@ -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

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index a57e53a..d098567 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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.

diff --git a/libgfortran/io/intrinsics.c b/libgfortran/io/intrinsics.c
index 4beb013..f2f532b 100644 (file)
--- a/libgfortran/io/intrinsics.c
+++ b/libgfortran/io/intrinsics.c
@@ -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)