1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
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
|
