From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001
From: upstream source tree <ports@midipix.org>
Date: Sun, 15 Mar 2015 20:14:05 -0400
Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified
 gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream
 tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
---
 gcc/testsuite/gfortran.dg/advance_6.f90 | 76 +++++++++++++++++++++++++++++++++
 1 file changed, 76 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/advance_6.f90

(limited to 'gcc/testsuite/gfortran.dg/advance_6.f90')

diff --git a/gcc/testsuite/gfortran.dg/advance_6.f90 b/gcc/testsuite/gfortran.dg/advance_6.f90
new file mode 100644
index 000000000..1a42cca92
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/advance_6.f90
@@ -0,0 +1,76 @@
+! { dg-do run { target fd_truncate } }
+! 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
-- 
cgit v1.2.3