1! { dg-do run }
2! { dg-options "-fbackslash" }
3! PR41328 and PR41168 Improper read of CR-LF sequences.
4! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
5program main
6   implicit none
7   integer :: iostat, n_chars_read, k
8   character(len=1) :: buffer(64) = ""
9   character (len=80) :: u
10
11   ! Set up the test file with normal file end.
12   open(unit=10, file="crlftest", form="unformatted", access="stream",&
13   & status="replace")
14   write(10) "a\rb\rc\r" ! CR at the end of each record.
15   close(10, status="keep")
16
17   open(unit=10, file="crlftest", form="formatted", status="old")
18
19   read( unit=10, fmt='(64A)', advance='NO', iostat=iostat,          &
20         size=n_chars_read ) buffer
21   if (n_chars_read.ne.1) call abort
22   if (any(buffer(1:n_chars_read).ne."a")) call abort
23   if (.not.is_iostat_eor(iostat)) call abort
24
25   read( unit=10, fmt='(64A)', advance='NO', iostat=iostat,          &
26         size=n_chars_read ) buffer
27   if (n_chars_read.ne.1) call abort
28   if (any(buffer(1:n_chars_read).ne."b")) call abort
29   if (.not.is_iostat_eor(iostat)) call abort
30
31   read( unit=10, fmt='(64A)', advance='NO', iostat=iostat,          &
32         size=n_chars_read ) buffer
33   if (n_chars_read.ne.1) call abort
34   if (any(buffer(1:n_chars_read).ne."c")) call abort
35   if (.not.is_iostat_eor(iostat)) call abort
36
37   read( unit=10, fmt='(64A)', advance='NO', iostat=iostat,          &
38         size=n_chars_read ) buffer
39   if (n_chars_read.ne.0) call abort
40   if (any(buffer(1:n_chars_read).ne."a")) call abort
41   if (.not.is_iostat_end(iostat)) call abort
42   close(10, status="delete")
43
44   ! Set up the test file with normal file end.
45   open(unit=10, file="crlftest", form="unformatted", access="stream",&
46   & status="replace")
47   write(10) "a\rb\rc\rno end of line marker" ! Note, no CR at end of file.
48   close(10, status="keep")
49
50   open(unit=10, file="crlftest", status='old')
51
52   do k = 1, 10
53     read(10,'(a80)',end=101,err=100) u
54     !print *,k,' : ',u(1:len_trim(u))
55   enddo
56
57100 continue
58   close(10, status="delete")
59   call abort
60
61101 continue
62   close(10, status="delete")
63   if (u(1:len_trim(u)).ne."no end of line marker") call abort
64end program main
65