PR libfortran/43605 FTELL intrinsic, take 2.

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

From-SVN: r157932

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/ftell_3.f90

 ! { 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

libgfortran/ChangeLog

+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.

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)