re PR fortran/80254 (Windows test failure: dec_io_2.f90)

2017-03-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	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

@@ -1,3 +1,9 @@
+2017-03-28  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	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  <jiong.wang@arm.com>
 
 	* g++.dg/tls/thread_local-order2.C: XFAIL on newlib.

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.

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: <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