gcc/testsuite/gfortran.dg/cr_lf.f90

   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>
   5 program 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
  57 100 continue
  58    close(10, status="delete")
  59    call abort
  60
  61 101 continue
  62    close(10, status="delete")
  63    if (u(1:len_trim(u)).ne."no end of line marker") call abort
  64 end program main