PR libfortran/43605 Fix FTELL for formatted files

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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b5aeaf5..466d63f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2010-04-01  Janne Blomqvist  <jb@gcc.gnu.org>
+           Manfred Schwarb  <manfred99@gmx.ch>
+
+       PR libfortran/43605
+       * gfortran.dg/ftell_3.f90: New test.
+
 2010-04-01  Richard Guenther  <rguenther@suse.de>
 
        PR middle-end/43614

diff --git a/gcc/testsuite/gfortran.dg/ftell_3.f90 b/gcc/testsuite/gfortran.dg/ftell_3.f90
index c16afe8..1981678 100644 (file)
--- a/gcc/testsuite/gfortran.dg/ftell_3.f90
+++ b/gcc/testsuite/gfortran.dg/ftell_3.f90
@@ -1,7 +1,6 @@
 ! { dg-do run }
 ! PR43605 FTELL intrinsic returns incorrect position
-! Contributed by Janne Blomqvist, Manfred Schwarb
-! and Dominique d'Humieres.
+! Contributed by Janne Blomqvist and Manfred Schwarb
 program ftell_3
   integer :: i
   character(len=99) :: buffer
@@ -16,13 +15,5 @@ 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 2385b64..495683c 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,9 @@
+2010-04-01  Janne Blomqvist  <jb@gcc.gnu.org>
+
+       PR libfortran/43605
+       * io/intrinsics.c (ftell): Reset fbuf, correct offset.
+       (FTELL_SUB): Likewise.
+
 2010-03-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libfortran/43265

diff --git a/libgfortran/io/intrinsics.c b/libgfortran/io/intrinsics.c
index f2f532b..66f68ec 100644 (file)
--- a/libgfortran/io/intrinsics.c
+++ b/libgfortran/io/intrinsics.c
@@ -280,7 +280,13 @@ export_proto_np(PREFIX(ftell));
 size_t
 PREFIX(ftell) (int * unit)
 {
-  return gf_ftell (*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;
 }
 
 #define FTELL_SUB(kind) \
@@ -289,7 +295,14 @@ PREFIX(ftell) (int * unit)
   void \
   ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \
   { \
-    *offset = gf_ftell (*unit);                        \
+    gfc_unit * u = find_unit (*unit); \
+    if (u == NULL) \
+      *offset = -1; \
+    else \
+      { \
+       *offset = stell (u->s) + fbuf_reset (u);        \
+       unlock_unit (u); \
+      } \
   }
 
 FTELL_SUB(1)