OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR libfortran/16597 (gfortran: bug in unformatted I/O on scratch files) 

2004-08-27  Bud Davis  <bdavis9659@comcast.net>

        PR fortran/16597
        * io/io.h: created typedef for unit_mode.
        * io/io.h (gfc_unit): added mode to unit structure.
        * io/transfer.c (data_transfer_init): flush if a write then
        read is done on a unit (direct access files).
        * io/rewind.c (st_rewind): Used unit mode instead of global.

        * gfortran.dg/pr16597.f90: New test.

From-SVN: r86654
This commit is contained in:
Bud Davis 2004-08-27 07:59:30 +00:00 committed by Bud Davis
parent dc700f497c
commit 55948b693e
6 changed files with 54 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2004-08-27 Bud Davis <bdavis9659@comcast.net>
PR fortran/16597
* gfortran.dg/pr16597.f90: New test.
2004-08-26 Joseph S. Myers <jsm@polyomino.org.uk>
PR c/13801

27
gcc/testsuite/gfortran.dg/pr16597.f90 Normal file
View File

@ -0,0 +1,27 @@
! pr 16597
! libgfortran
! reading a direct access record after it was written did
! not always return the correct data.
program gfbug4
implicit none
integer strlen
parameter (strlen = 4)
integer iunit
character string *4
iunit = 99
open (UNIT=iunit,FORM='unformatted',ACCESS='direct',RECL=strlen)
write (iunit, rec=1) 'ABCD'
read (iunit, rec=1) string
close (iunit)
if (string.ne.'ABCD') call abort
open (UNIT=iunit,FORM='unformatted',ACCESS='direct',STATUS='scratch',RECL=strlen)
write (iunit, rec=1) 'ABCD'
read (iunit, rec=1) string
close (iunit)
if (string.ne.'ABCD') call abort
end

9
libgfortran/ChangeLog
View File

@ -1,3 +1,12 @@
2004-08-27 Bud Davis <bdavis9659@comcast.net>
PR fortran/16597
* io/io.h: created typedef for unit_mode.
* io/io.h (gfc_unit): added mode to unit structure.
* io/transfer.c (data_transfer_init): flush if a write then
read is done on a unit (direct access files).
* io/rewind.c (st_rewind): Used unit mode instead of global.
2004-08-24 Bud Davis <bdavis9659@comcast.net>
PR fortran/17143

7
libgfortran/io/io.h
View File

@ -144,7 +144,9 @@ typedef enum
{ ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
unit_advance;
typedef enum
{READING, WRITING}
unit_mode;
/* Statement parameters. These are all the things that can appear in
an I/O statement. Some are inputs and some are outputs, but none
@ -271,6 +273,7 @@ typedef struct gfc_unit
{ NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
endfile;
unit_mode mode;
unit_flags flags;
gfc_offset recl, last_record, maxrec, bytes_left;
@ -299,7 +302,7 @@ typedef struct
gfc_unit *unit_root;
int seen_dollar;
enum {READING, WRITING} mode;
unit_mode mode;
unit_blank blank_status;
enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;

2
libgfortran/io/rewind.c
View File

@ -40,7 +40,7 @@ st_rewind (void)
"Cannot REWIND a file opened for DIRECT access");
else
{
if (g.mode==WRITING)
if (u->mode==WRITING)
struncate(u->s);
u->last_record = 0;
if (sseek (u->s, 0) == FAILURE)

8
libgfortran/io/transfer.c
View File

@ -1044,13 +1044,19 @@ data_transfer_init (int read_flag)
return;
}
/* Position the file. */
/* Check to see if we might be reading what we wrote before */
if (g.mode == READING && current_unit->mode == WRITING)
flush(current_unit->s);
/* Position the file. */
if (sseek (current_unit->s,
(ioparm.rec - 1) * current_unit->recl) == FAILURE)
generate_error (ERROR_OS, NULL);
}
current_unit->mode = g.mode;
/* Set the initial value of flags. */
g.blank_status = current_unit->flags.blank;