diff options
| -rw-r--r-- | gcc/testsuite/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/backspace.f | 82 | ||||
| -rw-r--r-- | libgfortran/ChangeLog | 11 | ||||
| -rw-r--r-- | libgfortran/io/backspace.c | 15 |
4 files changed, 113 insertions, 4 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2b3c2ce..612dcab 100644 --- 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 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 0272638..ebcac0b 100644 --- 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 f8ab01c..225f69c 100644 --- 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: |