+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
-! { dg-do run { target fd_truncate } }
+! { dg-do run }
! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
! Test of decimal= feature
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)
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
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
-! { 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,
-! { 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
-! { 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"
read(10,*) a
read(10,*) b
read(10,*) c
+ close(10)
if (a.ne.b) call abort()
IF (b.ne.c) call abort()
end
-! { 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
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()
-! { 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
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
-! { 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>
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',", &
" /"
rewind(99)
read(99,nml=nam)
-close(99,status="delete")
+close(99)
if (b01234567890123456789012345678901234567890123456789012345678901(1).ne.&
" AAP NOOT MIES WIM ZUS JET ") call abort
-! { 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
j = -42
nlstr = '&nml str = "a", "b", "cde", j = 5 /'
read(nlstr,nml)
+ open(99, status="scratch")
write(99,nml)
rewind(99)
j = -54
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
-! { 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
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"
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
-! { 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
iarr = 0
+ open(10, status="scratch")
write(10,*) " 2*1 3*2 /"
write(10,*) " 12"
write(10,*) " 13"
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
-! { 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>
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
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
-! { 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.
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