mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-01-17 02:34:50 +08:00
Code Issues Packages Projects Releases Wiki Activity

rewind.c (st_rewind): Reset unit to read mode.

Browse Source 
* io/rewind.c (st_rewind): Reset unit to read mode.
testsuite/
	* gfortran.dg/rewind_1.f90: New test.

From-SVN: r86659
This commit is contained in:
Paul Brook 2004-08-27 13:44:52 +00:00 committed by Paul Brook
parent 57406c63cd
commit c100eff11e
4 changed files with 31 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,7 @@
2004-08-27 Paul Brook <paul@codesourcery.com>
* gfortran.dg/rewind_1.f90: New test.
2004-08-27 Bud Davis <bdavis9659@comcast.net>
PR fortran/16597

18
gcc/testsuite/gfortran.dg/rewind_1.f90 Normal file
View File

@ -0,0 +1,18 @@
! { dg-do run }
! Check that rewind doesn't delete a file.
! Writing to the file truncates it at the end of the current record. Out
! IO library was defering the actual truncation until the file was rewound.
! A second rewind would then (incorrectly) think the file had just been
! written to, and truncate the file to zero length.
program foo
character*11 s
open(unit=11, status="SCRATCH")
write(11, '(a11)') "Hello World"
rewind(11)
rewind(11)
s = ""
read(11, '(a11)') s
close(11)
if (s .ne. "Hello World") call abort
end program

4
libgfortran/ChangeLog
View File

@ -1,3 +1,7 @@
2004-08-27 Paul Brook <paul@codesourcery.com>
* io/rewind.c (st_rewind): Reset unit to read mode.
2004-08-27 Bud Davis <bdavis9659@comcast.net>
PR fortran/16597

5
libgfortran/io/rewind.c
View File

@ -40,8 +40,13 @@ st_rewind (void)
"Cannot REWIND a file opened for DIRECT access");
else
{
/* If we have been writing to the file, the last written record
is the last record in the file, so trincate the file now.
Reset to read mode so two consecutive rewind statements
don't delete the file contents. */
if (u->mode==WRITING)
struncate(u->s);
u->mode = READING;
u->last_record = 0;
if (sseek (u->s, 0) == FAILURE)
generate_error (ERROR_OS, NULL);