1! { dg-do run { target { ! { *-*-mingw* } } } } 2! { dg-options "-fdec" } 3! 4! Run-time tests for various carriagecontrol parameters with DEC I/O. 5! Ensures the output is as defined. 6! 7 8subroutine write_lines(fd) 9 implicit none 10 integer, intent(in) :: fd 11 write(fd, '(A)') "+ first" 12 write(fd, '(A)') "-second line" 13 write(fd, '(A)') "0now you know" 14 write(fd, '(A)') "1this is the fourth line" 15 write(fd, '(A)') "$finally we have a new challenger for the final line" 16 write(fd, '(A)') CHAR(0)//"this is the end" 17 write(fd, '(A)') " this is a plain old line" 18endsubroutine 19 20subroutine check_cc (cc, fname, expected) 21 implicit none 22 ! carraigecontrol type, file name to write to 23 character(*), intent(in) :: cc, fname 24 ! expected output 25 character(*), intent(in) :: expected 26 27 ! read buffer, line number, unit, status 28 character(len=:), allocatable :: buf 29 integer :: i, fd, siz 30 fd = 3 31 32 ! write lines using carriagecontrol setting 33 open(unit=fd, file=fname, action='write', carriagecontrol=cc) 34 call write_lines(fd) 35 close(unit=fd) 36 37 open(unit=fd, file=fname, action='readwrite', & 38 form='unformatted', access='stream') 39 call fseek(fd, 0, 0) 40 inquire(file=fname, size=siz) 41 allocate(character(len=siz) :: buf) 42 read(unit=fd, pos=1) buf 43 if (buf .ne. expected) then 44 print *, '=================> ',cc,' <=================' 45 print *, '***** actual *****' 46 print *, buf 47 print *, '***** expected *****' 48 print *, expected 49 deallocate(buf) 50 close(unit=fd) 51 STOP 1 52 else 53 deallocate(buf) 54 close(unit=fd, status='delete') 55 endif 56endsubroutine 57 58implicit none 59 60character(*), parameter :: fname = 'dec_io_2.txt' 61 62!! In NONE mode, there are no line breaks between records. 63character(*), parameter :: output_ccnone = & 64 "+ first"//& 65 "-second line"//& 66 "0now you know"//& 67 "1this is the fourth line"//& 68 "$finally we have a new challenger for the final line"//& 69 CHAR(0)//"this is the end"//& 70 " this is a plain old line" 71 72!! In LIST mode, each record is terminated with a newline. 73character(*), parameter :: output_cclist = & 74 "+ first"//CHAR(10)//& 75 "-second line"//CHAR(10)//& 76 "0now you know"//CHAR(10)//& 77 "1this is the fourth line"//CHAR(10)//& 78 "$finally we have a new challenger for the final line"//CHAR(10)//& 79 CHAR(0)//"this is the end"//CHAR(10)//& 80 " this is a plain old line"//CHAR(10) 81 82!! In FORTRAN mode, the default record break is CR, and the first character 83!! implies the start- and end-of-record formatting. 84! '+' Overprinting: <text> CR 85! '-' One line feed: NL <text> CR 86! '0' Two line feeds: NL NL <text> CR 87! '1' Next page: FF <text> CR 88! '$' Prompting: NL <text> 89!'\0' Overprinting with no advance: <text> 90! Other: defaults to Overprinting <text> CR 91character(*), parameter :: output_ccfort = ""//& 92 " first"//CHAR(13)//& 93 CHAR(10)//"second line"//CHAR(13)//& 94 CHAR(10)//CHAR(10)//"now you know"//CHAR(13)//& 95 CHAR(12)//"this is the fourth line"//CHAR(13)//& 96 CHAR(10)//"finally we have a new challenger for the final line"//& 97 "this is the end"//& 98 CHAR(10)//"this is a plain old line"//CHAR(13) 99 100call check_cc('none', fname, output_ccnone) 101call check_cc('list', fname, output_cclist) 102call check_cc('fortran', fname, output_ccfort) 103 104end 105