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

4 files changed, 131 insertions, 0 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fc93202..da2f7a5 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.
diff --git a/gcc/testsuite/gfortran.dg/advance_6.f90 b/gcc/testsuite/gfortran.dg/advance_6.f90
new file mode 100644
index 0000000..f1967b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/advance_6.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/direct_io_7.f90 b/gcc/testsuite/gfortran.dg/direct_io_7.f90
new file mode 100644
index 0000000..ff116b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_7.f90
@@ -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
+
diff --git a/gcc/testsuite/gfortran.dg/streamio_13.f90 b/gcc/testsuite/gfortran.dg/streamio_13.f90
new file mode 100644
index 0000000..e37535b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_13.f90
@@ -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