PR libfortran/39667 Fix testcases to not need fd_truncate.

From-SVN: r151144

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/f2003_io_4.f03

-! { 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

gcc/testsuite/gfortran.dg/fmt_cache_1.f

-! { 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,

gcc/testsuite/gfortran.dg/fmt_exhaust.f90

-! { 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

gcc/testsuite/gfortran.dg/fmt_t_4.f90

-! { 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

gcc/testsuite/gfortran.dg/fseek.f90

-! { 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()

gcc/testsuite/gfortran.dg/list_read_5.f90

-! { 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

gcc/testsuite/gfortran.dg/namelist_39.f90

-! { 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

gcc/testsuite/gfortran.dg/namelist_56.f90

-! { 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

gcc/testsuite/gfortran.dg/read_bad_advance.f90

-! { 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

gcc/testsuite/gfortran.dg/read_repeat.f90

-! { 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

gcc/testsuite/gfortran.dg/read_size_noadvance.f90

-! { 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
 

gcc/testsuite/gfortran.dg/read_x_past.f

-! { 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