mirror of
https://gcc.gnu.org/git/gcc.git
synced 2025-01-27 06:44:12 +08:00
re PR libfortran/34370 (file positioning after nonadvancing i/o)
2007-12-13 Thomas Koenig <tkoenig@gcc.gnu.org> PR libfortran/34370 PR libfortran/34323 PR libfortran/34405 * io/io.h: Add previous_nonadvancing_write to gfc_unit. Add prototype for finish_last_advance_record. * io/file_pos.c (st_backspace): Generate error if backspace is attempted for direct access or unformatted stream. If there are bytes left from a previous ADVANCE="no", write them out before performing the backspace. (st_endfile): Generate error if endfile is attempted for direct access. If there are bytes left from a previous ADVANCE="no", write them out before performing the endfile. (st_rewind): Generate error if rewind is attempted for direct access. * unit.c (close_unit_1): Move functionality to write previously written bytes to... (finish_last_advance_record): ... here. * transfer.c (data_transfer_init): If reading, reset previous_nonadvancing_write. (finalize_transfer): Set the previous_noadvancing_write flag if we are writing and ADVANCE="no" was specified. Only call next_record() if advance="no" wasn't specified. 2007-12-13 Thomas Koenig <tkoenig@gcc.gnu.org> PR libfortran/34370 PR libfortran/34323 PR libfortran/34405 * gfortran.dg/advance_6.f90: New test case. * gfortran.dg/direct_io_7.f90: New test case. * gfortran.dg/streamio_13.f90: New test case. From-SVN: r130912
This commit is contained in:
Thomas Koenig
parent
a2b3eb5c97
commit
108bc19009
@ -1,3 +1,12 @@
|
||||
2007-12-13 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR libfortran/34370
|
||||
PR libfortran/34323
|
||||
PR libfortran/34405
|
||||
* gfortran.dg/advance_6.f90: New test case.
|
||||
* gfortran.dg/direct_io_7.f90: New test case.
|
||||
* gfortran.dg/streamio_13.f90: New test case.
|
||||
|
||||
2007-12-13 Douglas Gregor <doug.gregor@gmail.com>
|
||||
|
||||
* g++.dg/cpp0x/__func__.C: New.
|
||||
|
||||
76
gcc/testsuite/gfortran.dg/advance_6.f90
Normal file
76
gcc/testsuite/gfortran.dg/advance_6.f90
Normal file
@ -0,0 +1,76 @@
|
||||
! { dg-do run }
|
||||
! PR 34370 - file positioning after non-advancing I/O didn't add
|
||||
! a record marker.
|
||||
|
||||
program main
|
||||
implicit none
|
||||
character(len=3) :: c
|
||||
character(len=80), parameter :: fname = "advance_backspace_1.dat"
|
||||
|
||||
call write_file
|
||||
close (95)
|
||||
call check_end_record
|
||||
|
||||
call write_file
|
||||
backspace 95
|
||||
c = 'xxx'
|
||||
read (95,'(A)') c
|
||||
if (c /= 'ab ') call abort
|
||||
close (95)
|
||||
call check_end_record
|
||||
|
||||
call write_file
|
||||
backspace 95
|
||||
close (95)
|
||||
call check_end_record
|
||||
|
||||
call write_file
|
||||
endfile 95
|
||||
close (95)
|
||||
call check_end_record
|
||||
|
||||
call write_file
|
||||
endfile 95
|
||||
rewind 95
|
||||
c = 'xxx'
|
||||
read (95,'(A)') c
|
||||
if (c /= 'ab ') call abort
|
||||
close (95)
|
||||
call check_end_record
|
||||
|
||||
call write_file
|
||||
rewind 95
|
||||
c = 'xxx'
|
||||
read (95,'(A)') c
|
||||
if (c /= 'ab ') call abort
|
||||
close (95)
|
||||
call check_end_record
|
||||
|
||||
contains
|
||||
|
||||
subroutine write_file
|
||||
open(95, file=fname, status="replace", form="formatted")
|
||||
write (95, '(A)', advance="no") 'a'
|
||||
write (95, '(A)', advance="no") 'b'
|
||||
end subroutine write_file
|
||||
|
||||
! Checks for correct end record, then deletes the file.
|
||||
|
||||
subroutine check_end_record
|
||||
character(len=1) :: x
|
||||
open(2003, file=fname, status="old", access="stream", form="unformatted")
|
||||
read(2003) x
|
||||
if (x /= 'a') call abort
|
||||
read(2003) x
|
||||
if (x /= 'b') call abort
|
||||
read(2003) x
|
||||
if (x /= achar(10)) then
|
||||
read(2003) x
|
||||
if (x /= achar(13)) then
|
||||
else
|
||||
call abort
|
||||
end if
|
||||
end if
|
||||
close(2003,status="delete")
|
||||
end subroutine check_end_record
|
||||
end program main
|
||||
31
gcc/testsuite/gfortran.dg/direct_io_7.f90
Normal file
31
gcc/testsuite/gfortran.dg/direct_io_7.f90
Normal file
@ -0,0 +1,31 @@
|
||||
! { dg-do run }
|
||||
! PR 34405 - direct access prohibits ENDFILE, BACKSPACE and REWIND
|
||||
program test
|
||||
implicit none
|
||||
integer :: ios
|
||||
character(len=80) :: msg
|
||||
open (95, access="direct", recl=4, status="scratch")
|
||||
write (95,rec=1) 'abcd'
|
||||
|
||||
ios = 0
|
||||
msg = " "
|
||||
backspace (95,iostat=ios,iomsg=msg)
|
||||
if (ios == 0 .or. &
|
||||
msg /= "Cannot BACKSPACE a file opened for DIRECT access") call abort
|
||||
|
||||
ios = 0
|
||||
msg = " "
|
||||
endfile (95,iostat=ios,iomsg=msg)
|
||||
if (ios == 0 .or. &
|
||||
msg /= "Cannot perform ENDFILE on a file opened for DIRECT access") &
|
||||
call abort
|
||||
|
||||
ios = 0
|
||||
msg = " "
|
||||
rewind (95,iostat=ios,iomsg=msg)
|
||||
if (ios == 0 .or. &
|
||||
msg /= "Cannot REWIND a file opened for DIRECT access ") call abort
|
||||
|
||||
close (95)
|
||||
end program test
|
||||
|
||||
15
gcc/testsuite/gfortran.dg/streamio_13.f90
Normal file
15
gcc/testsuite/gfortran.dg/streamio_13.f90
Normal file
@ -0,0 +1,15 @@
|
||||
! { dg-do run }
|
||||
! PR 34405 - BACKSPACE for unformatted stream files is prohibited.
|
||||
program main
|
||||
implicit none
|
||||
integer :: ios
|
||||
character(len=80) :: msg
|
||||
open(2003,form="unformatted",access="stream",status="scratch")
|
||||
write (2003) 1
|
||||
write (2003) 2
|
||||
ios = 0
|
||||
msg = ' '
|
||||
backspace (2003,iostat=ios,iomsg=msg)
|
||||
if (ios == 0 .or. msg /="Cannot BACKSPACE an unformatted stream file") &
|
||||
call abort
|
||||
end program main
|
||||
@ -1,3 +1,29 @@
|
||||
2007-12-13 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR libfortran/34370
|
||||
PR libfortran/34323
|
||||
PR libfortran/34405
|
||||
* io/io.h: Add previous_nonadvancing_write to gfc_unit.
|
||||
Add prototype for finish_last_advance_record.
|
||||
* io/file_pos.c (st_backspace): Generate error if backspace is
|
||||
attempted for direct access or unformatted stream.
|
||||
If there are bytes left from a previous ADVANCE="no", write
|
||||
them out before performing the backspace.
|
||||
(st_endfile): Generate error if endfile is attempted for
|
||||
direct access.
|
||||
If there are bytes left from a previous ADVANCE="no", write
|
||||
them out before performing the endfile.
|
||||
(st_rewind): Generate error if rewind is attempted for
|
||||
direct access.
|
||||
* unit.c (close_unit_1): Move functionality to write
|
||||
previously written bytes to...
|
||||
(finish_last_advance_record): ... here.
|
||||
* transfer.c (data_transfer_init): If reading, reset
|
||||
previous_nonadvancing_write.
|
||||
(finalize_transfer): Set the previous_noadvancing_write
|
||||
flag if we are writing and ADVANCE="no" was specified.
|
||||
Only call next_record() if advance="no" wasn't specified.
|
||||
|
||||
2007-12-13 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/34427
|
||||
|
||||
@ -199,12 +199,22 @@ st_backspace (st_parameter_filepos *fpp)
|
||||
goto done;
|
||||
}
|
||||
|
||||
/* Ignore direct access. Non-advancing I/O is only allowed for formatted
|
||||
sequential I/O and the next direct access transfer repositions the file
|
||||
anyway. */
|
||||
/* Direct access is prohibited, and so is unformatted stream access. */
|
||||
|
||||
if (u->flags.access == ACCESS_DIRECT || u->flags.access == ACCESS_STREAM)
|
||||
goto done;
|
||||
|
||||
if (u->flags.access == ACCESS_DIRECT)
|
||||
{
|
||||
generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
|
||||
"Cannot BACKSPACE a file opened for DIRECT access");
|
||||
goto done;
|
||||
}
|
||||
|
||||
if (u->flags.access == ACCESS_STREAM && u->flags.form == FORM_UNFORMATTED)
|
||||
{
|
||||
generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
|
||||
"Cannot BACKSPACE an unformatted stream file");
|
||||
goto done;
|
||||
}
|
||||
|
||||
/* Check for special cases involving the ENDFILE record first. */
|
||||
|
||||
@ -224,6 +234,15 @@ st_backspace (st_parameter_filepos *fpp)
|
||||
|
||||
if (u->mode == WRITING)
|
||||
{
|
||||
/* If there are previously written bytes from a write with
|
||||
ADVANCE="no", add a record marker before performing the
|
||||
BACKSPACE. */
|
||||
|
||||
if (u->previous_nonadvancing_write)
|
||||
finish_last_advance_record (u);
|
||||
|
||||
u->previous_nonadvancing_write = 0;
|
||||
|
||||
flush (u->s);
|
||||
struncate (u->s);
|
||||
u->mode = READING;
|
||||
@ -261,6 +280,22 @@ st_endfile (st_parameter_filepos *fpp)
|
||||
u = find_unit (fpp->common.unit);
|
||||
if (u != NULL)
|
||||
{
|
||||
if (u->flags.access == ACCESS_DIRECT)
|
||||
{
|
||||
generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
|
||||
"Cannot perform ENDFILE on a file opened"
|
||||
" for DIRECT access");
|
||||
goto done;
|
||||
}
|
||||
|
||||
/* If there are previously written bytes from a write with ADVANCE="no",
|
||||
add a record marker before performing the ENDFILE. */
|
||||
|
||||
if (u->previous_nonadvancing_write)
|
||||
finish_last_advance_record (u);
|
||||
|
||||
u->previous_nonadvancing_write = 0;
|
||||
|
||||
if (u->current_record)
|
||||
{
|
||||
st_parameter_dt dtp;
|
||||
@ -274,6 +309,7 @@ st_endfile (st_parameter_filepos *fpp)
|
||||
struncate (u->s);
|
||||
u->endfile = AFTER_ENDFILE;
|
||||
update_position (u);
|
||||
done:
|
||||
unlock_unit (u);
|
||||
}
|
||||
|
||||
@ -299,6 +335,14 @@ st_rewind (st_parameter_filepos *fpp)
|
||||
"Cannot REWIND a file opened for DIRECT access");
|
||||
else
|
||||
{
|
||||
/* If there are previously written bytes from a write with ADVANCE="no",
|
||||
add a record marker before performing the ENDFILE. */
|
||||
|
||||
if (u->previous_nonadvancing_write)
|
||||
finish_last_advance_record (u);
|
||||
|
||||
u->previous_nonadvancing_write = 0;
|
||||
|
||||
/* Flush the buffers. If we have been writing to the file, the last
|
||||
written record is the last record in the file, so truncate the
|
||||
file now. Reset to read mode so two consecutive rewind
|
||||
|
||||
@ -451,7 +451,8 @@ typedef struct gfc_unit
|
||||
struct gfc_unit *left, *right;
|
||||
int priority;
|
||||
|
||||
int read_bad, current_record, saved_pos;
|
||||
int read_bad, current_record, saved_pos, previous_nonadvancing_write;
|
||||
|
||||
enum
|
||||
{ NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
|
||||
endfile;
|
||||
@ -692,6 +693,9 @@ internal_proto(unlock_unit);
|
||||
extern void update_position (gfc_unit *);
|
||||
internal_proto(update_position);
|
||||
|
||||
extern void finish_last_advance_record (gfc_unit *u);
|
||||
internal_proto (finish_last_advance_record);
|
||||
|
||||
/* open.c */
|
||||
|
||||
extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
|
||||
|
||||
@ -1891,6 +1891,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
|
||||
|
||||
if (read_flag)
|
||||
{
|
||||
dtp->u.p.current_unit->previous_nonadvancing_write = 0;
|
||||
|
||||
if ((cf & IOPARM_EOR) != 0 && dtp->u.p.advance_status != ADVANCE_NO)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_MISSING_OPTION,
|
||||
@ -2644,9 +2646,14 @@ finalize_transfer (st_parameter_dt *dtp)
|
||||
return;
|
||||
}
|
||||
|
||||
if (dtp->u.p.mode == WRITING)
|
||||
dtp->u.p.current_unit->previous_nonadvancing_write
|
||||
= dtp->u.p.advance_status == ADVANCE_NO;
|
||||
|
||||
if (is_stream_io (dtp))
|
||||
{
|
||||
if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
|
||||
if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED
|
||||
&& dtp->u.p.advance_status != ADVANCE_NO)
|
||||
next_record (dtp, 1);
|
||||
|
||||
if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED
|
||||
|
||||
@ -581,27 +581,8 @@ close_unit_1 (gfc_unit *u, int locked)
|
||||
|
||||
/* If there are previously written bytes from a write with ADVANCE="no"
|
||||
Reposition the buffer before closing. */
|
||||
if (u->saved_pos > 0)
|
||||
{
|
||||
char *p;
|
||||
|
||||
p = salloc_w (u->s, &u->saved_pos);
|
||||
|
||||
if (!(u->unit_number == options.stdout_unit
|
||||
|| u->unit_number == options.stderr_unit))
|
||||
{
|
||||
size_t len;
|
||||
|
||||
const char crlf[] = "\r\n";
|
||||
#ifdef HAVE_CRLF
|
||||
len = 2;
|
||||
#else
|
||||
len = 1;
|
||||
#endif
|
||||
if (swrite (u->s, &crlf[2-len], &len) != 0)
|
||||
os_error ("Close after ADVANCE_NO failed");
|
||||
}
|
||||
}
|
||||
if (u->previous_nonadvancing_write)
|
||||
finish_last_advance_record (u);
|
||||
|
||||
rc = (u->s == NULL) ? 0 : sclose (u->s) == FAILURE;
|
||||
|
||||
@ -718,3 +699,27 @@ filename_from_unit (int n)
|
||||
return (char *) NULL;
|
||||
}
|
||||
|
||||
void
|
||||
finish_last_advance_record (gfc_unit *u)
|
||||
{
|
||||
char *p;
|
||||
|
||||
if (u->saved_pos > 0)
|
||||
p = salloc_w (u->s, &u->saved_pos);
|
||||
|
||||
if (!(u->unit_number == options.stdout_unit
|
||||
|| u->unit_number == options.stderr_unit))
|
||||
{
|
||||
size_t len;
|
||||
|
||||
const char crlf[] = "\r\n";
|
||||
#ifdef HAVE_CRLF
|
||||
len = 2;
|
||||
#else
|
||||
len = 1;
|
||||
#endif
|
||||
if (swrite (u->s, &crlf[2-len], &len) != 0)
|
||||
os_error ("Completing record after ADVANCE_NO failed");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user