OSDN Git Service

PR libfortran/43605 FTELL intrinsic, take 2.
authorjb@138bc75d-0d04-0410-961f-82ee72b054a4 <jb@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 1 Apr 2010 20:51:45 +0000 (20:51 +0000)
committerMasaki Muranaka <monaka@monami-software.com>
Sun, 23 May 2010 00:42:46 +0000 (09:42 +0900)
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@157932 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/ftell_3.f90
libgfortran/ChangeLog
libgfortran/io/intrinsics.c

index 8cefbf4..16b901b 100644 (file)
@@ -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
index 1981678..c16afe8 100644 (file)
@@ -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
index a57e53a..d098567 100644 (file)
@@ -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.
index 4beb013..f2f532b 100644 (file)
@@ -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)