From: jb@138bc75d-0d04-0410-961f-82ee72b054a4 <jb@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Thu, 1 Apr 2010 20:51:45 +0000 (+0000)
Subject: PR libfortran/43605 FTELL intrinsic, take 2.
X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=commitdiff_plain;h=db1c5889c2a94c95ba2d3a2733c54da0e82c7e54

PR libfortran/43605 FTELL intrinsic, take 2.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@157932 138bc75d-0d04-0410-961f-82ee72b054a4
---

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8cefbf4125a..16b901b8310 100644
--- 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 1981678d41c..c16afe8ed16 100644
--- 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 a57e53aabf2..d0985674a18 100644
--- 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 4beb0135c86..f2f532b9291 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)