1! { dg-do run { target fd_truncate } } 2! PR 34370 - file positioning after non-advancing I/O didn't add 3! a record marker. 4 5program main 6 implicit none 7 character(len=3) :: c 8 character(len=80), parameter :: fname = "advance_backspace_1.dat" 9 10 call write_file 11 close (95) 12 call check_end_record 13 14 call write_file 15 backspace 95 16 c = 'xxx' 17 read (95,'(A)') c 18 if (c /= 'ab ') call abort 19 close (95) 20 call check_end_record 21 22 call write_file 23 backspace 95 24 close (95) 25 call check_end_record 26 27 call write_file 28 endfile 95 29 close (95) 30 call check_end_record 31 32 call write_file 33 endfile 95 34 rewind 95 35 c = 'xxx' 36 read (95,'(A)') c 37 if (c /= 'ab ') call abort 38 close (95) 39 call check_end_record 40 41 call write_file 42 rewind 95 43 c = 'xxx' 44 read (95,'(A)') c 45 if (c /= 'ab ') call abort 46 close (95) 47 call check_end_record 48 49contains 50 51 subroutine write_file 52 open(95, file=fname, status="replace", form="formatted") 53 write (95, '(A)', advance="no") 'a' 54 write (95, '(A)', advance="no") 'b' 55 end subroutine write_file 56 57! Checks for correct end record, then deletes the file. 58 59 subroutine check_end_record 60 character(len=1) :: x 61 open(2003, file=fname, status="old", access="stream", form="unformatted") 62 read(2003) x 63 if (x /= 'a') call abort 64 read(2003) x 65 if (x /= 'b') call abort 66 read(2003) x 67 if (x /= achar(10)) then 68 read(2003) x 69 if (x /= achar(13)) then 70 else 71 call abort 72 end if 73 end if 74 close(2003,status="delete") 75 end subroutine check_end_record 76end program main 77