! { dg-do run { target fd_truncate } }
|
! { dg-do run { target fd_truncate } }
|
! PR 34370 - file positioning after non-advancing I/O didn't add
|
! PR 34370 - file positioning after non-advancing I/O didn't add
|
! a record marker.
|
! a record marker.
|
|
|
program main
|
program main
|
implicit none
|
implicit none
|
character(len=3) :: c
|
character(len=3) :: c
|
character(len=80), parameter :: fname = "advance_backspace_1.dat"
|
character(len=80), parameter :: fname = "advance_backspace_1.dat"
|
|
|
call write_file
|
call write_file
|
close (95)
|
close (95)
|
call check_end_record
|
call check_end_record
|
|
|
call write_file
|
call write_file
|
backspace 95
|
backspace 95
|
c = 'xxx'
|
c = 'xxx'
|
read (95,'(A)') c
|
read (95,'(A)') c
|
if (c /= 'ab ') call abort
|
if (c /= 'ab ') call abort
|
close (95)
|
close (95)
|
call check_end_record
|
call check_end_record
|
|
|
call write_file
|
call write_file
|
backspace 95
|
backspace 95
|
close (95)
|
close (95)
|
call check_end_record
|
call check_end_record
|
|
|
call write_file
|
call write_file
|
endfile 95
|
endfile 95
|
close (95)
|
close (95)
|
call check_end_record
|
call check_end_record
|
|
|
call write_file
|
call write_file
|
endfile 95
|
endfile 95
|
rewind 95
|
rewind 95
|
c = 'xxx'
|
c = 'xxx'
|
read (95,'(A)') c
|
read (95,'(A)') c
|
if (c /= 'ab ') call abort
|
if (c /= 'ab ') call abort
|
close (95)
|
close (95)
|
call check_end_record
|
call check_end_record
|
|
|
call write_file
|
call write_file
|
rewind 95
|
rewind 95
|
c = 'xxx'
|
c = 'xxx'
|
read (95,'(A)') c
|
read (95,'(A)') c
|
if (c /= 'ab ') call abort
|
if (c /= 'ab ') call abort
|
close (95)
|
close (95)
|
call check_end_record
|
call check_end_record
|
|
|
contains
|
contains
|
|
|
subroutine write_file
|
subroutine write_file
|
open(95, file=fname, status="replace", form="formatted")
|
open(95, file=fname, status="replace", form="formatted")
|
write (95, '(A)', advance="no") 'a'
|
write (95, '(A)', advance="no") 'a'
|
write (95, '(A)', advance="no") 'b'
|
write (95, '(A)', advance="no") 'b'
|
end subroutine write_file
|
end subroutine write_file
|
|
|
! Checks for correct end record, then deletes the file.
|
! Checks for correct end record, then deletes the file.
|
|
|
subroutine check_end_record
|
subroutine check_end_record
|
character(len=1) :: x
|
character(len=1) :: x
|
open(2003, file=fname, status="old", access="stream", form="unformatted")
|
open(2003, file=fname, status="old", access="stream", form="unformatted")
|
read(2003) x
|
read(2003) x
|
if (x /= 'a') call abort
|
if (x /= 'a') call abort
|
read(2003) x
|
read(2003) x
|
if (x /= 'b') call abort
|
if (x /= 'b') call abort
|
read(2003) x
|
read(2003) x
|
if (x /= achar(10)) then
|
if (x /= achar(10)) then
|
read(2003) x
|
read(2003) x
|
if (x /= achar(13)) then
|
if (x /= achar(13)) then
|
else
|
else
|
call abort
|
call abort
|
end if
|
end if
|
end if
|
end if
|
close(2003,status="delete")
|
close(2003,status="delete")
|
end subroutine check_end_record
|
end subroutine check_end_record
|
end program main
|
end program main
|
|
|