From e35229f83e1fa1da69b85dab0466545442b6fa80 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Wed, 29 Mar 2017 17:30:58 +0000 Subject: [PATCH] re PR fortran/80254 (Windows test failure: dec_io_2.f90) 2017-03-28 Thomas Koenig PR fortran/80254 * gfortran.dg/dec_io_2.f90: Do not run on MINGW, run * gfortran.dg/dec_io_2a.f90: instead (new test). From-SVN: r246573 --- gcc/testsuite/ChangeLog | 6 ++ gcc/testsuite/gfortran.dg/dec_io_2.f90 | 2 +- gcc/testsuite/gfortran.dg/dec_io_2a.f90 | 104 ++++++++++++++++++++++++ 3 files changed, 111 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/dec_io_2a.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6801cba65fc..ce511267046 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2017-03-28 Thomas Koenig + + PR fortran/80254 + * gfortran.dg/dec_io_2.f90: Do not run on MINGW, run + * gfortran.dg/dec_io_2a.f90: instead (new test). + 2017-03-28 Jiong Wang * g++.dg/tls/thread_local-order2.C: XFAIL on newlib. diff --git a/gcc/testsuite/gfortran.dg/dec_io_2.f90 b/gcc/testsuite/gfortran.dg/dec_io_2.f90 index 9adc4f4003f..dc05f5170c9 100644 --- a/gcc/testsuite/gfortran.dg/dec_io_2.f90 +++ b/gcc/testsuite/gfortran.dg/dec_io_2.f90 @@ -1,4 +1,4 @@ -! { dg-do run } +! { dg-do run { target { ! { *-*-mingw* } } } } ! { dg-options "-fdec" } ! ! Run-time tests for various carriagecontrol parameters with DEC I/O. diff --git a/gcc/testsuite/gfortran.dg/dec_io_2a.f90 b/gcc/testsuite/gfortran.dg/dec_io_2a.f90 new file mode 100644 index 00000000000..f3e4739cf8d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_io_2a.f90 @@ -0,0 +1,104 @@ +! { 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) + call abort() + 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(13)//CHAR(10)//& + "-second line"//CHAR(13)//CHAR(10)//& + "0now you know"//CHAR(13)//CHAR(10)//& + "1this is the fourth line"//CHAR(13)//CHAR(10)//& + "$finally we have a new challenger for the final line"//CHAR(13)//CHAR(10)//& + CHAR(0)//"this is the end"//CHAR(13)//CHAR(10)//& + " this is a plain old line"//CHAR(13)//CHAR(10) + +!! In FORTRAN mode, the default record break is CR, and the first character +!! implies the start- and end-of-record formatting. +! '+' Overprinting: CR +! '-' One line feed: NL CR +! '0' Two line feeds: NL NL CR +! '1' Next page: FF CR +! '$' Prompting: NL +!'\0' Overprinting with no advance: +! Other: defaults to Overprinting 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 -- 2.30.2