PR libfortran/39667 Fix testcases to not need fd_truncate.
From-SVN: r151144
This commit is contained in:
Janne Blomqvist
parent
f994f296e1
commit
20d1cba13b
|
|
@ -1,3 +1,20 @@
|
|||
2009-08-27 Janne Blomqvist <jb@gcc.gnu.org>
|
||||
|
||||
PR libfortran/39667
|
||||
* gfortran.dg/f2003_io_4.f03: Don't require target fd_truncate,
|
||||
open temp file with status="scratch".
|
||||
* gfortran.dg/fmt_cache_1.f: Likewise
|
||||
* gfortran.dg/fmt_exhaust.f90: Likewise
|
||||
* gfortran.dg/fmt_t_4.f90: Likewise
|
||||
* gfortran.dg/fseek.f90: Likewise
|
||||
* gfortran.dg/list_read_5.f90: Likewise
|
||||
* gfortran.dg/namelist_39.f90: Likewise
|
||||
* gfortran.dg/namelist_56.f90: Likewise
|
||||
* gfortran.dg/read_bad_advance.f90: Likewise
|
||||
* gfortran.dg/read_repeat.f90: Likewise
|
||||
* gfortran.dg/read_size_noadvance.f90: Likewise
|
||||
* gfortran.dg/read_x_past.f: Likewise
|
||||
|
||||
2009-08-27 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/28039
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! { dg-do run { target fd_truncate } }
|
||||
! { dg-do run }
|
||||
! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
! Test of decimal= feature
|
||||
|
||||
|
|
@ -10,7 +10,7 @@ msg = "yes"
|
|||
a = 43.21
|
||||
b = 3.131
|
||||
c = 5.432
|
||||
open(99, decimal="comma")
|
||||
open(99, decimal="comma", status="scratch")
|
||||
write(99,'(10f8.3)') a
|
||||
a = 0.0
|
||||
rewind(99)
|
||||
|
|
@ -20,8 +20,8 @@ if (any(a.ne.43.21)) call abort
|
|||
write(msg,'(dp,f8.3,dc,f8.2,dp,f8.3)', decimal="comma") a(1), b(1), c(1)
|
||||
if (trim(msg).ne." 43.210 3,13 5.432") call abort
|
||||
|
||||
close(99, status="delete")
|
||||
open(99, decimal="comma")
|
||||
close(99)
|
||||
open(99, decimal="comma", status="scratch")
|
||||
write(99,nml=mynml)
|
||||
a = 0.0
|
||||
b = 0.0
|
||||
|
|
@ -29,5 +29,5 @@ rewind(99)
|
|||
read(99,nml=mynml)
|
||||
if (any(a.ne.43.21)) call abort
|
||||
if (any(b.ne.3.131)) call abort
|
||||
close(99, status="delete")
|
||||
close(99)
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
! { dg-do run { target fd_truncate } }
|
||||
! { dg-do run }
|
||||
! pr40662 segfaults when specific format is invoked twice.
|
||||
! pr40330 incorrect io.
|
||||
! test case derived from pr40662, <jvdelisle@gcc.gnu.org>
|
||||
program astap
|
||||
character(40) teststring
|
||||
arlxca = 0.0
|
||||
open(10)
|
||||
open(10, status="scratch")
|
||||
write(10,40) arlxca
|
||||
write(10,40) arlxca
|
||||
40 format(t4,"arlxca = ",1pg13.6,t27,"arlxcc = ",g13.6,t53,
|
||||
|
|
|
|||
|
|
@ -1,11 +1,12 @@
|
|||
! { dg-do run { target fd_truncate } }
|
||||
! { dg-do run }
|
||||
! PR27304 Test running out of data descriptors with data remaining.
|
||||
! Derived from case in PR. Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>.
|
||||
program test
|
||||
implicit none
|
||||
integer :: n
|
||||
n = 1
|
||||
open(10, status="scratch")
|
||||
write(10,"(i7,(' abcd'))", err=10) n, n
|
||||
call abort()
|
||||
10 close(10, status="delete")
|
||||
10 close(10)
|
||||
end program test
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! { dg-do run { target fd_truncate } }
|
||||
! { dg-do run }
|
||||
! PR31199, test case from PR report.
|
||||
program write_write
|
||||
character(len=20) :: a,b,c
|
||||
open(10, status="scratch")
|
||||
write (10,"(a,t1,a,a)") "xxxxxxxxx", "abc", "def"
|
||||
write (10,"(a,t1,a)",advance='no') "xxxxxxxxx", "abc"
|
||||
write (10,"(a)") "def"
|
||||
|
|
@ -10,6 +11,7 @@
|
|||
read(10,*) a
|
||||
read(10,*) b
|
||||
read(10,*) c
|
||||
close(10)
|
||||
if (a.ne.b) call abort()
|
||||
IF (b.ne.c) call abort()
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! { dg-do run { target fd_truncate } }
|
||||
! { dg-do run }
|
||||
|
||||
PROGRAM test_fseek
|
||||
INTEGER, PARAMETER :: SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2, fd=10
|
||||
|
|
@ -12,6 +12,7 @@ PROGRAM test_fseek
|
|||
close (911)
|
||||
if (newline_length < 1 .or. newline_length > 2) call abort()
|
||||
|
||||
open(fd, status="scratch")
|
||||
! expected position: one leading blank + 10 + newline
|
||||
WRITE(fd, *) "1234567890"
|
||||
IF (FTELL(fd) /= 11 + newline_length) CALL abort()
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! { dg-do run { target fd_truncate } }
|
||||
! { dg-do run }
|
||||
! PR25307 Check handling of end-of-file conditions for list directed reads.
|
||||
! Prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
program pr25307
|
||||
|
|
@ -18,6 +18,7 @@ program pr25307
|
|||
if (j.ne.0) call abort()
|
||||
! Check file unit
|
||||
i = 0
|
||||
open(10, status="scratch")
|
||||
write(10,'(a)') "123"
|
||||
rewind(10)
|
||||
read(10, *, end=20) i,j
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! { dg-do run { target fd_truncate } }
|
||||
! { dg-do run }
|
||||
! PR33421 and PR33253 Weird quotation of namelist output of character arrays
|
||||
! Test case from Toon Moone, adapted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
|
|
@ -9,7 +9,7 @@ implicit none
|
|||
character(len=45) :: b01234567890123456789012345678901234567890123456789012345678901(3)
|
||||
namelist /nam/ b01234567890123456789012345678901234567890123456789012345678901
|
||||
b01234567890123456789012345678901234567890123456789012345678901 = 'x'
|
||||
open(99)
|
||||
open(99, status="scratch")
|
||||
write(99,'(4(a,/),a)') "&NAM", &
|
||||
" b01234567890123456789012345678901234567890123456789012345678901(1)=' AAP NOOT MIES WIM ZUS JET',", &
|
||||
" b01234567890123456789012345678901234567890123456789012345678901(2)='SURF.PRESSURE',", &
|
||||
|
|
@ -17,7 +17,7 @@ write(99,'(4(a,/),a)') "&NAM", &
|
|||
" /"
|
||||
rewind(99)
|
||||
read(99,nml=nam)
|
||||
close(99,status="delete")
|
||||
close(99)
|
||||
|
||||
if (b01234567890123456789012345678901234567890123456789012345678901(1).ne.&
|
||||
" AAP NOOT MIES WIM ZUS JET ") call abort
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! { dg-do run { target fd_truncate } }
|
||||
! { dg-do run }
|
||||
! PR37707 Namelist read of array of derived type incorrect
|
||||
! Test case from Tobias Burnus
|
||||
IMPLICIT NONE
|
||||
|
|
@ -10,6 +10,7 @@
|
|||
j = -42
|
||||
nlstr = '&nml str = "a", "b", "cde", j = 5 /'
|
||||
read(nlstr,nml)
|
||||
open(99, status="scratch")
|
||||
write(99,nml)
|
||||
rewind(99)
|
||||
j = -54
|
||||
|
|
@ -17,5 +18,5 @@
|
|||
read(99,nml)
|
||||
if (j.ne.5) call abort
|
||||
if (any(str.ne.["a ","b ","cde "," "])) call abort
|
||||
close(99,status="delete")
|
||||
close(99)
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! { dg-do run { target fd_truncate } }
|
||||
! { dg-do run }
|
||||
! PR27138 Failure to advance line on bad list directed read.
|
||||
! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
program test
|
||||
|
|
@ -7,7 +7,7 @@
|
|||
real :: rtype
|
||||
complex :: ctype
|
||||
logical :: ltype
|
||||
OPEN (10)
|
||||
OPEN (10, status="scratch")
|
||||
write(10,*) "aaaa aaaa aaaa aaaa"
|
||||
write(10,*) "bbbb bbbb bbbb bbbb"
|
||||
write(10,*) "cccc cccc cccc cccc"
|
||||
|
|
@ -25,8 +25,8 @@
|
|||
goto 99
|
||||
80 READ (10,*,END=99,ERR=99) ntype
|
||||
if (ntype.ne.1234) goto 99
|
||||
close(10, status="delete")
|
||||
close(10)
|
||||
stop
|
||||
99 close(10, status="delete")
|
||||
99 close(10)
|
||||
call abort()
|
||||
end program test
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! { dg-do run { target fd_truncate } }
|
||||
! { dg-do run }
|
||||
! PR39528 repeated entries not read when using list-directed input.
|
||||
! Test case derived from reporters example.
|
||||
program rread
|
||||
|
|
@ -7,6 +7,7 @@ program rread
|
|||
|
||||
iarr = 0
|
||||
|
||||
open(10, status="scratch")
|
||||
write(10,*) " 2*1 3*2 /"
|
||||
write(10,*) " 12"
|
||||
write(10,*) " 13"
|
||||
|
|
@ -20,5 +21,5 @@ program rread
|
|||
if (any(iarr(6:7).ne.0)) call abort
|
||||
if (ia .ne. 12 .or. ib .ne. 13) call abort
|
||||
|
||||
close(10, status="delete")
|
||||
close(10)
|
||||
end program rread
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! { dg-do run { target fd_truncate } }
|
||||
! { dg-do run }
|
||||
! PR26890 Test for use of SIZE variable in IO list.
|
||||
! Test case from Paul Thomas.
|
||||
! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
|
@ -6,7 +6,7 @@
|
|||
character(80) :: buffer, line
|
||||
integer :: nchars
|
||||
line = "The quick brown fox jumps over the lazy dog."
|
||||
open (10)
|
||||
open (10, status="scratch")
|
||||
write (10, '(a)') trim(line)
|
||||
rewind (10)
|
||||
read (10, '(a)', advance = 'no', size = nchars, eor = 998) buffer
|
||||
|
|
@ -18,6 +18,6 @@
|
|||
read (10, '(a)', advance = 'no', size = nchars, eor = 999) buffer(:nchars)
|
||||
999 if (nchars.ne.44) call abort()
|
||||
if (buffer.ne.line) call abort()
|
||||
close (10, status="delete")
|
||||
close (10)
|
||||
end
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! { dg-do run { target fd_truncate } }
|
||||
! { dg-do run }
|
||||
! { dg-options -w }
|
||||
! PR 26661 : Test reading X's past file end with no LF or CR.
|
||||
! PR 26880 : Tests that rewind clears the gfc_unit read_bad flag.
|
||||
|
|
@ -6,12 +6,12 @@
|
|||
implicit none
|
||||
character(3) a(4)
|
||||
integer i
|
||||
open (10)
|
||||
open (10, status="scratch")
|
||||
10 format(A,$) ! This is not pedantic
|
||||
write(10,10)' abc def ghi jkl'
|
||||
rewind(10)
|
||||
read(10,20)(a(i),i=1,4)
|
||||
if (a(4).ne."jkl") call abort()
|
||||
20 format(1x,a3,1x,a3,1x,a3,1x,a3,10x)
|
||||
close(10, status="delete")
|
||||
close(10)
|
||||
end
|
||||
|
|
|
|||
Loading…
Reference in New Issue