]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
PR libfortran/39667 Fix testcases to not need fd_truncate.
authorJanne Blomqvist <jb@gcc.gnu.org>
Thu, 27 Aug 2009 17:40:55 +0000 (20:40 +0300)
committerJanne Blomqvist <jb@gcc.gnu.org>
Thu, 27 Aug 2009 17:40:55 +0000 (20:40 +0300)
From-SVN: r151144

13 files changed:
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/f2003_io_4.f03
gcc/testsuite/gfortran.dg/fmt_cache_1.f
gcc/testsuite/gfortran.dg/fmt_exhaust.f90
gcc/testsuite/gfortran.dg/fmt_t_4.f90
gcc/testsuite/gfortran.dg/fseek.f90
gcc/testsuite/gfortran.dg/list_read_5.f90
gcc/testsuite/gfortran.dg/namelist_39.f90
gcc/testsuite/gfortran.dg/namelist_56.f90
gcc/testsuite/gfortran.dg/read_bad_advance.f90
gcc/testsuite/gfortran.dg/read_repeat.f90
gcc/testsuite/gfortran.dg/read_size_noadvance.f90
gcc/testsuite/gfortran.dg/read_x_past.f

index 379012fed27751030663067520c88503d081629e..c9979cae52f55c87a1c0bdfdcf61880f8fc25b6b 100644 (file)
@@ -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
index 92c708c2921ccef77c88be3c11dfdc2018738042..fa09737b402d441ec8cf24da8869d113d0f74032 100644 (file)
@@ -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
index 825b44c11a724f63554734d130899e979c4b14b7..41de3f0d705c903827ebfd2a2c38d2d2ce197575 100644 (file)
@@ -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,
index bea3f8005325a43fb0d7fbe633cfad8622e68133..bd9c8bcfb3f9a4c11d686c821dbb623da6463252 100644 (file)
@@ -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
index 62b8d49c046dee052173b039ba077b912c35b22f..6c96f7ba8bf982bf8e799286fe16646c4c95781c 100644 (file)
@@ -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
index 2649063ac590c7385d7cee67eaa093afe46f2527..9e3c7195a3a327fb6a4e0f7efd7a1890eea1e5b9 100644 (file)
@@ -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()
index 658c5249722da4bda7b88098730b1d1c24c8cec4..14b0d1648a4da07628ae1e49c5a4ab6ff4317cea 100644 (file)
@@ -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
index 82e631e0dd0be0209262b646cb99b112a348fe61..427ba6dc2bf5ae61ae3661fe02a4038d687bdfe7 100644 (file)
@@ -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
index 8d879fc910b5bbb2e751947ebd680edb1710372c..658d12f6fcaac93e44c24a7a716112f186043d32 100644 (file)
@@ -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
index 3ca4493c451fe0ce129282c378a2f7b0456cdf04..539ada496bebca5c57a1cdccef2ad6870705f62c 100644 (file)
@@ -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
index ab7a6a4c7d5eda03f95fd8f1c1923d119c5dbc45..e0bf39ee01bae363b85670cab6b086aae4481a68 100644 (file)
@@ -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
index 37ecff90d650c6d016ed809a656a469b71319b1a..e611547b63b36f38f999bb9f61c8ca903ab30e08 100644 (file)
@@ -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
 
index 16f662345482e366f8eab78add14b5c0d01ff861..3d6b01239106f6724bd4f8edcfffa770bfb3a720 100644 (file)
@@ -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