summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/advance_6.f90
blob: 1a42cca923d290a3de5ecee65a1b3efdf058267f (plain)
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