URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [advance_6.f90] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log


! { 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

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { dg-do run { target fd_truncate } }`
2			`! PR 34370 - file positioning after non-advancing I/O didn't add`
3			`! a record marker.`
4
5			`program 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
49			`contains`
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`
76			`end program main`

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [advance_6.f90] - Blame information for rev 801