re PR libfortran/20068 (Backspace problems)

	PR libfortran/20068
	PR libfortran/20125
	PR libfortran/20156
	PR libfortran/20471

	* io/backspace.c (unformatted_backspace): Fix error in arithmetic.
	(st_backspace): When in WRITING mode, we flush and falling back
	into READING mode. In all cases, correctly position the stream.

	* gfortran.dg/backspace.f: New test.

Co-Authored-By: Francois-Xavier Coudert <coudert@clipper.ens.fr>
From-SVN: r97478

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2b3c2ce56d4d41afeb192b45504c03be14f8084f..612dcab58956c5fa94904eb6e303a96a47e692a3 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+2005-04-03  Dale Ranta  <dir@lanl.gov>
+            Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+       PR libfortran/20068
+       PR libfortran/20125
+       PR libfortran/20156
+       PR libfortran/20471
+       * gfortran.dg/backspace.f: New test.
+
 2005-04-02  Daniel Berlin  <dberlin@dberlin.org>
 
        * gcc.dg/pr19345.c: New test.

diff --git a/gcc/testsuite/gfortran.dg/backspace.f b/gcc/testsuite/gfortran.dg/backspace.f
new file mode 100644 (file)
index 0000000..ebf43f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backspace.f
@@ -0,0 +1,82 @@
+! This file is all about BACKSPACE
+! {dg-do run}
+
+      integer i, n, nr
+      real x(10), y(10)
+
+! PR libfortran/20068
+      open (20, status='scratch')
+      write (20,*) 1
+      write (20,*) 2
+      write (20,*) 3
+      rewind (20)
+      read (20,*) i
+      if (i .ne. 1) call abort
+      write (*,*) ' '
+      backspace (20)
+      read (20,*) i
+      if (i .ne. 1) call abort
+      close (20)
+
+! PR libfortran/20125
+      open (20, status='scratch')
+      write (20,*) 7
+      backspace (20)
+      read (20,*) i
+      if (i .ne. 7) call abort
+      close (20)
+
+      open (20, status='scratch', form='unformatted')
+      write (20) 8
+      backspace (20)
+      read (20) i
+      if (i .ne. 8) call abort
+      close (20)
+
+! PR libfortran/20471
+      do n = 1, 10
+        x(n) = sqrt(real(n))
+      end do
+      open (3, form='unformatted', status='scratch')
+      write (3) (x(n),n=1,10)
+      backspace (3)
+      rewind (3)
+      read (3) (y(n),n=1,10)
+
+      do n = 1, 10
+        if (abs(x(n)-y(n)) > 0.00001) call abort
+      end do
+      close (3)
+
+! PR libfortran/20156
+      open (3, form='unformatted', status='scratch')
+      do i = 1, 5
+        x(1) = i
+        write (3) n, (x(n),n=1,10)
+      end do
+      nr = 0
+      rewind (3)
+  20  continue
+      read (3,end=30,err=90) n, (x(n),n=1,10)
+      nr = nr + 1
+      goto 20
+  30  continue
+      if (nr .ne. 5) call abort
+
+      do i = 1, nr+1
+        backspace (3)
+      end do
+
+      do i = 1, nr
+        read(3,end=70,err=90) n, (x(n),n=1,10)
+        if (abs(x(1) - i) .gt. 0.001) call abort
+      end do
+      close (3)
+      stop
+
+  70  continue
+      call abort
+  90  continue
+      call abort
+
+      end

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 027263899d0828dd553f9188f673454d9765e564..ebcac0bb919365da9f9812d724aa690a1437add1 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,14 @@
+2005-04-03  Dale Ranta  <dir@lanl.gov>
+            Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+       PR libfortran/20068
+       PR libfortran/20125
+       PR libfortran/20156
+       PR libfortran/20471
+       * io/backspace.c (unformatted_backspace): Fix error in arithmetic.
+       (st_backspace): When in WRITING mode, we flush and falling back
+       into READING mode. In all cases, correctly position the stream.
+
 2005-03-31  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
        PR libfortran/20660

diff --git a/libgfortran/io/backspace.c b/libgfortran/io/backspace.c
index f8ab01c348809d837dcfa8b4973b1ff67dff3b0a..225f69cc45a17ec5c86a4c184d8a4b7f529b4457 100644 (file)
--- a/libgfortran/io/backspace.c
+++ b/libgfortran/io/backspace.c
@@ -111,7 +111,7 @@ unformatted_backspace (void)
   if (p == NULL)
     goto io_error;
 
-  new = file_position (current_unit->s) - *p - length;
+  new = file_position (current_unit->s) - *p - 2*length;
   if (sseek (current_unit->s, new) == FAILURE)
     goto io_error;
 
@@ -155,16 +155,23 @@ st_backspace (void)
     u->endfile = AT_ENDFILE;
   else
     {
-      if (u->current_record)
-       next_record (1);
-
       if (file_position (u->s) == 0)
        goto done;              /* Common special case */
 
+      if (u->mode == WRITING)
+      {
+       flush (u->s);
+       struncate (u->s);
+       u->mode = READING;
+      }
+
       if (u->flags.form == FORM_FORMATTED)
        formatted_backspace ();
       else
        unformatted_backspace ();
+
+      u->endfile = NO_ENDFILE;
+      u->current_record = 0;
     }
 
  done: