From 4aad2c8af8bcef4cf146827040a044b19a7f8540 Mon Sep 17 00:00:00 2001 From: jb Date: Thu, 27 Aug 2009 17:40:55 +0000 Subject: [PATCH] PR libfortran/39667 Fix testcases to not need fd_truncate. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151144 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/testsuite/ChangeLog | 17 +++++++++++++++++ gcc/testsuite/gfortran.dg/f2003_io_4.f03 | 10 +++++----- gcc/testsuite/gfortran.dg/fmt_cache_1.f | 4 ++-- gcc/testsuite/gfortran.dg/fmt_exhaust.f90 | 5 +++-- gcc/testsuite/gfortran.dg/fmt_t_4.f90 | 4 +++- gcc/testsuite/gfortran.dg/fseek.f90 | 3 ++- gcc/testsuite/gfortran.dg/list_read_5.f90 | 3 ++- gcc/testsuite/gfortran.dg/namelist_39.f90 | 6 +++--- gcc/testsuite/gfortran.dg/namelist_56.f90 | 5 +++-- gcc/testsuite/gfortran.dg/read_bad_advance.f90 | 8 ++++---- gcc/testsuite/gfortran.dg/read_repeat.f90 | 5 +++-- gcc/testsuite/gfortran.dg/read_size_noadvance.f90 | 6 +++--- gcc/testsuite/gfortran.dg/read_x_past.f | 6 +++--- 13 files changed, 53 insertions(+), 29 deletions(-) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 379012f..c9979ca 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,20 @@ +2009-08-27 Janne Blomqvist + + 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 PR fortran/28039 diff --git a/gcc/testsuite/gfortran.dg/f2003_io_4.f03 b/gcc/testsuite/gfortran.dg/f2003_io_4.f03 index 92c708c..fa09737 100644 --- a/gcc/testsuite/gfortran.dg/f2003_io_4.f03 +++ b/gcc/testsuite/gfortran.dg/f2003_io_4.f03 @@ -1,4 +1,4 @@ -! { dg-do run { target fd_truncate } } +! { dg-do run } ! Test case prepared by Jerry DeLisle ! 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 diff --git a/gcc/testsuite/gfortran.dg/fmt_cache_1.f b/gcc/testsuite/gfortran.dg/fmt_cache_1.f index 825b44c..41de3f0 100644 --- a/gcc/testsuite/gfortran.dg/fmt_cache_1.f +++ b/gcc/testsuite/gfortran.dg/fmt_cache_1.f @@ -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, 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, diff --git a/gcc/testsuite/gfortran.dg/fmt_exhaust.f90 b/gcc/testsuite/gfortran.dg/fmt_exhaust.f90 index bea3f80..bd9c8bc 100644 --- a/gcc/testsuite/gfortran.dg/fmt_exhaust.f90 +++ b/gcc/testsuite/gfortran.dg/fmt_exhaust.f90 @@ -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 . 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 diff --git a/gcc/testsuite/gfortran.dg/fmt_t_4.f90 b/gcc/testsuite/gfortran.dg/fmt_t_4.f90 index 62b8d49..6c96f7b 100644 --- a/gcc/testsuite/gfortran.dg/fmt_t_4.f90 +++ b/gcc/testsuite/gfortran.dg/fmt_t_4.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/fseek.f90 b/gcc/testsuite/gfortran.dg/fseek.f90 index 2649063..9e3c719 100644 --- a/gcc/testsuite/gfortran.dg/fseek.f90 +++ b/gcc/testsuite/gfortran.dg/fseek.f90 @@ -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() diff --git a/gcc/testsuite/gfortran.dg/list_read_5.f90 b/gcc/testsuite/gfortran.dg/list_read_5.f90 index 658c524..14b0d16 100644 --- a/gcc/testsuite/gfortran.dg/list_read_5.f90 +++ b/gcc/testsuite/gfortran.dg/list_read_5.f90 @@ -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 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 diff --git a/gcc/testsuite/gfortran.dg/namelist_39.f90 b/gcc/testsuite/gfortran.dg/namelist_39.f90 index 82e631e..427ba6d 100644 --- a/gcc/testsuite/gfortran.dg/namelist_39.f90 +++ b/gcc/testsuite/gfortran.dg/namelist_39.f90 @@ -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 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/namelist_56.f90 b/gcc/testsuite/gfortran.dg/namelist_56.f90 index 8d879fc..658d12f 100644 --- a/gcc/testsuite/gfortran.dg/namelist_56.f90 +++ b/gcc/testsuite/gfortran.dg/namelist_56.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/read_bad_advance.f90 b/gcc/testsuite/gfortran.dg/read_bad_advance.f90 index 3ca4493..539ada4 100644 --- a/gcc/testsuite/gfortran.dg/read_bad_advance.f90 +++ b/gcc/testsuite/gfortran.dg/read_bad_advance.f90 @@ -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 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 diff --git a/gcc/testsuite/gfortran.dg/read_repeat.f90 b/gcc/testsuite/gfortran.dg/read_repeat.f90 index ab7a6a4..e0bf39e 100644 --- a/gcc/testsuite/gfortran.dg/read_repeat.f90 +++ b/gcc/testsuite/gfortran.dg/read_repeat.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/read_size_noadvance.f90 b/gcc/testsuite/gfortran.dg/read_size_noadvance.f90 index 37ecff9..e611547 100644 --- a/gcc/testsuite/gfortran.dg/read_size_noadvance.f90 +++ b/gcc/testsuite/gfortran.dg/read_size_noadvance.f90 @@ -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 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/read_x_past.f b/gcc/testsuite/gfortran.dg/read_x_past.f index 16f6623..3d6b012 100644 --- a/gcc/testsuite/gfortran.dg/read_x_past.f +++ b/gcc/testsuite/gfortran.dg/read_x_past.f @@ -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 -- 2.7.4