[Patch, libfortran] PR 43605 FTELL intrinsic, take 2

[Janne Blomqvist <blomqvist dot janne at gmail dot com>]

Hello,

the previous patch didn't cover all the bases, and a more advanced
testcase quickly brought up the next problem, which was due to failing
to correct the underlying stream offset. The attached patch fixes this
issue, and also moves the common implementation to a separate
function, which then the FUNCTION and SUBROUTINE entry points call.

Regtested on x86_64-unknown-linux-gnu, Ok for trunk (35 mins left
until freeze! :)) and 4.4?


-- 
Janne Blomqvist

Attachment: ChangeLog2
Description: Binary data

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

--- ftell_3.orig.f90	2010-04-01 23:14:07.000000000 +0300
+++ ftell_3.f90	2010-04-01 23:18:07.000000000 +0300
@@ -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