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