gcc/testsuite/gfortran.dg/dec_io_2.f90

! { dg-do run { target { ! { *-*-mingw* } } } }
! { dg-options "-fdec" }
!
! Run-time tests for various carriagecontrol parameters with DEC I/O.
! Ensures the output is as defined.
!

subroutine write_lines(fd)
  implicit none
  integer, intent(in) :: fd
  write(fd, '(A)') "+ first"
  write(fd, '(A)') "-second line"
  write(fd, '(A)') "0now you know"
  write(fd, '(A)') "1this is the fourth line"
  write(fd, '(A)') "$finally we have a new challenger for the final line"
  write(fd, '(A)') CHAR(0)//"this is the end"
  write(fd, '(A)') " this is a plain old line"
endsubroutine

subroutine check_cc (cc, fname, expected)
  implicit none
  ! carraigecontrol type, file name to write to
  character(*), intent(in) :: cc, fname
  ! expected output
  character(*), intent(in) :: expected

  ! read buffer, line number, unit, status
  character(len=:), allocatable :: buf
  integer :: i, fd, siz
  fd = 3

  ! write lines using carriagecontrol setting
  open(unit=fd, file=fname, action='write', carriagecontrol=cc)
  call write_lines(fd)
  close(unit=fd)

  open(unit=fd, file=fname, action='readwrite', &
       form='unformatted', access='stream')
  call fseek(fd, 0, 0)
  inquire(file=fname, size=siz)
  allocate(character(len=siz) :: buf)
  read(unit=fd, pos=1) buf
  if (buf .ne. expected) then
    print *, '=================> ',cc,' <================='
    print *, '*****  actual  *****'
    print *, buf
    print *, '***** expected *****'
    print *, expected
    deallocate(buf)
    close(unit=fd)
    STOP 1
  else
    deallocate(buf)
    close(unit=fd, status='delete')
  endif
endsubroutine

implicit none

character(*), parameter :: fname  = 'dec_io_2.txt'

!! In NONE mode, there are no line breaks between records.
character(*), parameter :: output_ccnone = &
  "+ first"//&
  "-second line"//&
  "0now you know"//&
  "1this is the fourth line"//&
  "$finally we have a new challenger for the final line"//&
  CHAR(0)//"this is the end"//&
  " this is a plain old line"

!! In LIST mode, each record is terminated with a newline.
character(*), parameter :: output_cclist = &
  "+ first"//CHAR(10)//&
  "-second line"//CHAR(10)//&
  "0now you know"//CHAR(10)//&
  "1this is the fourth line"//CHAR(10)//&
  "$finally we have a new challenger for the final line"//CHAR(10)//&
  CHAR(0)//"this is the end"//CHAR(10)//&
  " this is a plain old line"//CHAR(10)

!! In FORTRAN mode, the default record break is CR, and the first character
!! implies the start- and end-of-record formatting.
! '+' Overprinting: <text> CR
! '-' One line feed: NL <text> CR
! '0' Two line feeds: NL NL <text> CR
! '1' Next page: FF <text> CR
! '$' Prompting: NL <text>
!'\0' Overprinting with no advance: <text>
!     Other: defaults to Overprinting <text> CR
character(*), parameter :: output_ccfort = ""//&
  " first"//CHAR(13)//&
  CHAR(10)//"second line"//CHAR(13)//&
  CHAR(10)//CHAR(10)//"now you know"//CHAR(13)//&
  CHAR(12)//"this is the fourth line"//CHAR(13)//&
  CHAR(10)//"finally we have a new challenger for the final line"//&
  "this is the end"//&
  CHAR(10)//"this is a plain old line"//CHAR(13)

call check_cc('none',    fname, output_ccnone)
call check_cc('list',    fname, output_cclist)
call check_cc('fortran', fname, output_ccfort)

end