Commit ee56ac9d by Janne Blomqvist

Fix PR libfortran/39667

From-SVN: r147004
parent 43fcece8
2009-04-30 Janne Blomqvist <jb@gcc.gnu.org>
PR libfortran/39667
* gfortran.dg/advance_1.f90: Don't require target fd_truncate.
* gfortran.dg/advance_4.f90: Likewise
* gfortran.dg/advance_5.f90: Likewise
* gfortran.dg/append_1.f90: Likewise
* gfortran.dg/backslash_1.f90: Likewise
* gfortran.dg/backslash_2.f90: Likewise
* gfortran.dg/backslash_3.f: Likewise
* gfortran.dg/backspace_10.f90: Likewise
* gfortran.dg/backspace_3.f: Likewise
* gfortran.dg/backspace_4.f: Likewise
* gfortran.dg/backspace_5.f: Likewise
* gfortran.dg/backspace_8.f: Likewise
* gfortran.dg/backspace_9.f: Likewise
* gfortran.dg/complex_write.f90: Likewise
* gfortran.dg/convert_implied_open.f90: Likewise
* gfortran.dg/dollar_edit_descriptor_1.f: Likewise
* gfortran.dg/dos_eol.f: Likewise
* gfortran.dg/empty_format_1.f90: Likewise
* gfortran.dg/endfile.f: Likewise
* gfortran.dg/eof_1.f90: Likewise
* gfortran.dg/eor_1.f90: Likewise
* gfortran.dg/eor_handling_1.f90: Likewise
* gfortran.dg/eor_handling_2.f90: Likewise
* gfortran.dg/eor_handling_3.f90: Likewise
* gfortran.dg/eor_handling_4.f90: Likewise
* gfortran.dg/eor_handling_5.f90: Likewise
* gfortran.dg/error_recovery_5.f90: Likewise
* gfortran.dg/f2003_inquire_1.f03: Likewise
* gfortran.dg/f2003_io_4.f03: Likewise
* gfortran.dg/f2003_io_5.f03: Likewise
* gfortran.dg/f2003_io_7.f03: Likewise
* gfortran.dg/fgetc_1.f90: Likewise
* gfortran.dg/fgetc_2.f90: Likewise
* gfortran.dg/flush_1.f90: Likewise
* gfortran.dg/fmt_exhaust.f90: Likewise
* gfortran.dg/fmt_huge.f90: Likewise
* gfortran.dg/fmt_read.f90: Likewise
* gfortran.dg/fmt_t_1.f90: Likewise
* gfortran.dg/fmt_t_2.f90: Likewise
* gfortran.dg/fmt_t_3.f90: Likewise
* gfortran.dg/fmt_t_4.f90: Likewise
* gfortran.dg/fmt_t_5.f90: Likewise
* gfortran.dg/fmt_t_7.f: Likewise
* gfortran.dg/fseek.f90: Likewise
* gfortran.dg/ftell_1.f90: Likewise
* gfortran.dg/ftell_2.f90: Likewise
* gfortran.dg/func_derived_3.f90: Likewise
* gfortran.dg/inquire_9.f90: Likewise
* gfortran.dg/iostat_1.f90: Likewise
* gfortran.dg/iostat_2.f90: Likewise
* gfortran.dg/list_read_1.f90: Likewise
* gfortran.dg/list_read_4.f90: Likewise
* gfortran.dg/list_read_5.f90: Likewise
* gfortran.dg/list_read_7.f90: Likewise
* gfortran.dg/list_read_8.f90: Likewise
* gfortran.dg/list_read_9.f90: Likewise
* gfortran.dg/namelist_13.f90: Likewise
* gfortran.dg/namelist_14.f90: Likewise
* gfortran.dg/namelist_15.f90: Likewise
* gfortran.dg/namelist_16.f90: Likewise
* gfortran.dg/namelist_17.f90: Likewise
* gfortran.dg/namelist_18.f90: Likewise
* gfortran.dg/namelist_19.f90: Likewise
* gfortran.dg/namelist_20.f90: Likewise
* gfortran.dg/namelist_24.f90: Likewise
* gfortran.dg/namelist_26.f90: Likewise
* gfortran.dg/namelist_27.f90: Likewise
* gfortran.dg/namelist_28.f90: Likewise
* gfortran.dg/namelist_37.f90: Likewise
* gfortran.dg/namelist_38.f90: Likewise
* gfortran.dg/namelist_39.f90: Likewise
* gfortran.dg/namelist_40.f90: Likewise
* gfortran.dg/namelist_43.f90: Likewise
* gfortran.dg/namelist_44.f90: Likewise
* gfortran.dg/namelist_45.f90: Likewise
* gfortran.dg/namelist_46.f90: Likewise
* gfortran.dg/namelist_47.f90: Likewise
* gfortran.dg/namelist_48.f90: Likewise
* gfortran.dg/namelist_49.f90: Likewise
* gfortran.dg/namelist_50.f90: Likewise
* gfortran.dg/namelist_51.f90: Likewise
* gfortran.dg/namelist_52.f90: Likewise
* gfortran.dg/namelist_56.f90: Likewise
* gfortran.dg/namelist_char_only.f90: Likewise
* gfortran.dg/namelist_use.f90: Likewise
* gfortran.dg/namelist_use_only.f90: Likewise
* gfortran.dg/noadv_size.f90: Likewise
* gfortran.dg/open_access_append_1.f90: Likewise
* gfortran.dg/pad_no.f90: Likewise
* gfortran.dg/pr12884.f: Likewise
* gfortran.dg/pr17090.f90: Likewise
* gfortran.dg/pr17285.f90: Likewise
* gfortran.dg/pr17286.f90: Likewise
* gfortran.dg/pr18122.f90: Likewise
* gfortran.dg/pr18210.f90: Likewise
* gfortran.dg/pr18392.f90: Likewise
* gfortran.dg/pr19155.f: Likewise
* gfortran.dg/pr19216.f: Likewise
* gfortran.dg/pr19467.f90: Likewise
* gfortran.dg/pr19657.f: Likewise
* gfortran.dg/pr20257.f90: Likewise
* gfortran.dg/read_bad_advance.f90: Likewise
* gfortran.dg/read_eof_2.f90: Likewise
* gfortran.dg/read_eof_4.f90: Likewise
* gfortran.dg/read_many_1.f: Likewise
* gfortran.dg/read_noadvance.f90: Likewise
* gfortran.dg/read_repeat.f90: Likewise
* gfortran.dg/read_size_noadvance.f90: Likewise
* gfortran.dg/read_x_past.f: Likewise
* gfortran.dg/record_marker_1.f90: Likewise
* gfortran.dg/record_marker_3.f90: Likewise
* gfortran.dg/rewind_1.f90: Likewise
* gfortran.dg/runtime_warning_1.f90: Likewise
* gfortran.dg/shape_3.f90: Likewise
* gfortran.dg/slash_1.f90: Likewise
* gfortran.dg/stat_1.f90: Likewise
* gfortran.dg/stat_2.f90: Likewise
* gfortran.dg/streamio_11.f90: Likewise
* gfortran.dg/streamio_3.f90: Likewise
* gfortran.dg/streamio_4.f90: Likewise
* gfortran.dg/streamio_9.f90: Likewise
* gfortran.dg/tl_editing.f90: Likewise
* gfortran.dg/unf_io_convert_1.f90: Likewise
* gfortran.dg/unf_io_convert_2.f90: Likewise
* gfortran.dg/unf_read_corrupted_2.f90: Likewise
* gfortran.dg/unf_short_record_1.f90: Likewise
* gfortran.dg/utf8_1.f03: Likewise
* gfortran.dg/utf8_2.f03: Likewise
* gfortran.dg/widechar_IO_1.f90: Likewise
* gfortran.dg/write_check3.f90: Likewise
* gfortran.dg/write_rewind_2.f: Likewise
* gfortran.dg/x_slash_2.f: Likewise
2009-04-29 Richard Guenther <rguenther@suse.de> 2009-04-29 Richard Guenther <rguenther@suse.de>
PR target/39943 PR target/39943
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR25463 Check that advance='no' works correctly. ! PR25463 Check that advance='no' works correctly.
! Derived from example given in PR by Thomas Koenig ! Derived from example given in PR by Thomas Koenig
! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR31207 Last record truncated for read after short write ! PR31207 Last record truncated for read after short write
program main program main
character(10) :: answer character(10) :: answer
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR31207 Last record truncated for read after short write. ! PR31207 Last record truncated for read after short write.
character(len=20) :: b character(len=20) :: b
! write something no advance ! write something no advance
......
! PR libfortran/21471 ! PR libfortran/21471
! Testing POSITION="APPEND" ! Testing POSITION="APPEND"
! !
! { dg-do run { target fd_truncate } } ! { dg-do run }
subroutine failed subroutine failed
close (10,status='delete') close (10,status='delete')
call abort call abort
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
character(len=4) a character(len=4) a
open (10, status='scratch') open (10, status='scratch')
write (10,'(A)') '1\n2' write (10,'(A)') '1\n2'
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options "-fbackslash" } ! { dg-options "-fbackslash" }
integer :: i, e integer :: i, e
open (10, status='scratch') open (10, status='scratch')
......
C { dg-do run { target fd_truncate } } C { dg-do run }
C { dg-options "-fbackslash" } C { dg-options "-fbackslash" }
C PR fortran/30278 C PR fortran/30278
program a program a
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR33307 I/O read/positioning problem - in BACKSPACE ! PR33307 I/O read/positioning problem - in BACKSPACE
! Test case devloped from test in PR by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Test case devloped from test in PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
program gfcbug69b program gfcbug69b
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR25598 Error on repeated backspaces. ! PR25598 Error on repeated backspaces.
! Derived from example given in PR by Dale Ranta ! Derived from example given in PR by Dale Ranta
! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR25598 Error on repeated backspaces. ! PR25598 Error on repeated backspaces.
! Derived from example given in PR by Dale Ranta ! Derived from example given in PR by Dale Ranta
! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
......
!{ dg-do run { target fd_truncate } } !{ dg-do run }
! PR26464 File I/O error related to buffering and BACKSPACE ! PR26464 File I/O error related to buffering and BACKSPACE
! Test case derived from case by Dale Ranta. ! Test case derived from case by Dale Ranta.
! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
......
C { dg-do run { target fd_truncate } } C { dg-do run }
C PR libfortran/31618 - backspace after an error didn't work. C PR libfortran/31618 - backspace after an error didn't work.
program main program main
character*78 msg character*78 msg
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR32235 incorrectly position text file after backspace ! PR32235 incorrectly position text file after backspace
! Test case from PR, prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Test case from PR, prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
program main program main
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! pr 19071 ! pr 19071
! test case provided by ! test case provided by
! Thomas.Koenig@online.de ! Thomas.Koenig@online.de
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options "-fconvert=swap" } ! { dg-options "-fconvert=swap" }
! PR 26735 - implied open didn't use to honor -fconvert ! PR 26735 - implied open didn't use to honor -fconvert
program main program main
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options "-w" } ! { dg-options "-w" }
! PR libfortran/20006 ! PR libfortran/20006
character*5 c character*5 c
......
! PR libfortran/19678 and PR libfortran/19679 ! PR libfortran/19678 and PR libfortran/19679
! { dg-do run { target fd_truncate } } ! { dg-do run }
integer i, j integer i, j
open (10,status='scratch') open (10,status='scratch')
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 17709 ! PR 17709
! We weren't resetting the internal EOR flag correctly, so the second read ! We weren't resetting the internal EOR flag correctly, so the second read
! wasn't advancing to the next line. ! wasn't advancing to the next line.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR25550 file data corrupted after reading end of file. ! PR25550 file data corrupted after reading end of file.
! Derived from example given in PR from Dale Ranta. ! Derived from example given in PR from Dale Ranta.
! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! Program to test for proper EOF errors when reading past the end of a file. ! Program to test for proper EOF errors when reading past the end of a file.
! We used to get this wrong when a formatted read followed a list formatted ! We used to get this wrong when a formatted read followed a list formatted
! read. ! read.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 19451: The test for advance='NO' with eor used to be reversed. ! PR 19451: The test for advance='NO' with eor used to be reversed.
program main program main
character*2 c character*2 c
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 17992: Reading an empty file should yield zero with pad='YES' ! PR 17992: Reading an empty file should yield zero with pad='YES'
! (which is the default). ! (which is the default).
! Test case supplied by milan@cmm.ki.si. ! Test case supplied by milan@cmm.ki.si.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 19568: Don't read across end of line when the format is longer ! PR 19568: Don't read across end of line when the format is longer
! than the line length and pad='yes' (default) ! than the line length and pad='yes' (default)
program main program main
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 19595: Handle end-of-record condition with pad=yes (default) ! PR 19595: Handle end-of-record condition with pad=yes (default)
program main program main
integer i1, i2 integer i1, i2
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 20092, 20131: Handle end-of-record condition with pad=yes (default) ! PR 20092, 20131: Handle end-of-record condition with pad=yes (default)
! for standard input. This test case only really tests anything if, ! for standard input. This test case only really tests anything if,
! by changing unit 5, you get to manipulate the standard input. ! by changing unit 5, you get to manipulate the standard input.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 20661: Handle non-advancing I/O with iostat ! PR 20661: Handle non-advancing I/O with iostat
! Test case by Walt Brainerd, The Fortran Company ! Test case by Walt Brainerd, The Fortran Company
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR34411 hang-up during read of non-expected input ! PR34411 hang-up during read of non-expected input
! Test case derived from that given in PR ! Test case derived from that given in PR
! Prior to patch, the do loop was infinite, limits set in this one ! Prior to patch, the do loop was infinite, limits set in this one
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options "-std=gnu" } ! { dg-options "-std=gnu" }
character(25) :: sround, ssign, sasynchronous, sdecimal, sencoding character(25) :: sround, ssign, sasynchronous, sdecimal, sencoding
integer :: vsize, vid integer :: vsize, vid
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
! Test of decimal= feature ! Test of decimal= feature
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
! Test of decimal="comma" in namelist and complex ! Test of decimal="comma" in namelist and complex
integer :: i integer :: i
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
! Test of sign=, decimal=, and blank= . ! Test of sign=, decimal=, and blank= .
program iotests program iotests
......
! Testcase for the FGETC and FPUTC intrinsics ! Testcase for the FGETC and FPUTC intrinsics
! { dg-do run { target fd_truncate } } ! { dg-do run }
character(len=5) s character(len=5) s
integer st integer st
......
! Testcase for the FGETC and FPUTC intrinsics ! Testcase for the FGETC and FPUTC intrinsics
! { dg-do run { target fd_truncate } } ! { dg-do run }
character(len=5) s character(len=5) s
integer st integer st
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 22390 Implement flush statement ! PR 22390 Implement flush statement
program flush_1 program flush_1
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR27304 Test running out of data descriptors with data remaining. ! PR27304 Test running out of data descriptors with data remaining.
! Derived from case in PR. Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>. ! Derived from case in PR. Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>.
program test program test
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR32446 printing big numbers in F0.1 format. ! PR32446 printing big numbers in F0.1 format.
! This segfaulted before the patch. ! This segfaulted before the patch.
open (10, status="scratch") open (10, status="scratch")
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! pr18398, missing data on sequential formatted reads ! pr18398, missing data on sequential formatted reads
! test contributed by Thomas.Koenig@online.de ! test contributed by Thomas.Koenig@online.de
open(7,status='scratch') open(7,status='scratch')
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
integer nrow, vec(15) integer nrow, vec(15)
open (10, status="scratch") open (10, status="scratch")
write (10, fmt='(a)') '001 1 2 3 4 5 6' write (10, fmt='(a)') '001 1 2 3 4 5 6'
......
! { dg-options "" } ! { dg-options "" }
! { dg-do run { target fd_truncate } } ! { dg-do run }
! pr24699, handle end-of-record on READ with T format ! pr24699, handle end-of-record on READ with T format
! test contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! test contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
character*132 :: foost1, foost2, foost3 character*132 :: foost1, foost2, foost3
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR31051 bug with x and t format descriptors. ! PR31051 bug with x and t format descriptors.
! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> from PR. ! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> from PR.
program t program t
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR31199, test case from PR report. ! PR31199, test case from PR report.
program write_write program write_write
character(len=20) :: a,b,c character(len=20) :: a,b,c
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR32678 GFortan works incorrectly when writing with FORMAT Tx ! PR32678 GFortan works incorrectly when writing with FORMAT Tx
! Before patch, NULLs were inserted in output. ! Before patch, NULLs were inserted in output.
! Test case from reporter enhanced to detect this problem. ! Test case from reporter enhanced to detect this problem.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR34974 null bytes when reverse-tabbing long records ! PR34974 null bytes when reverse-tabbing long records
! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
program test program test
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
PROGRAM test_fseek PROGRAM test_fseek
INTEGER, PARAMETER :: SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2, fd=10 INTEGER, PARAMETER :: SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2, fd=10
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
integer(kind=8) o, o2 integer(kind=8) o, o2
open (10, status="scratch") open (10, status="scratch")
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
integer(kind=8) o integer(kind=8) o
open (10, status="scratch") open (10, status="scratch")
if (ftell(10) /= 0) call abort if (ftell(10) /= 0) call abort
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! This tests the "virtual fix" for PR19561, where pointers to derived ! This tests the "virtual fix" for PR19561, where pointers to derived
! types were not generating correct code. This testcase is based on ! types were not generating correct code. This testcase is based on
! the original PR example. This example not only tests the ! the original PR example. This example not only tests the
......
! PR fortran/24774 ! PR fortran/24774
! { dg-do run { target fd_truncate } } ! { dg-do run }
logical :: l logical :: l
l = .true. l = .true.
inquire (file='inquire_9 file that should not exist', exist=l) inquire (file='inquire_9 file that should not exist', exist=l)
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 23598 - The iostat variable wasn't reset if the previous ! PR 23598 - The iostat variable wasn't reset if the previous
! I/O library call had an error. ! I/O library call had an error.
program main program main
......
! PR libfortran/23784 ! PR libfortran/23784
! { dg-do run { target fd_truncate } } ! { dg-do run }
integer i integer i
close(10, status="whatever", iostat=i) ! { dg-warning "STATUS specifier in CLOSE statement.*has invalid value" } close(10, status="whatever", iostat=i) ! { dg-warning "STATUS specifier in CLOSE statement.*has invalid value" }
if (i == 0) call abort() if (i == 0) call abort()
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! Program to test terminators in list-directed input ! Program to test terminators in list-directed input
program list_read_1 program list_read_1
character(len=5) :: s character(len=5) :: s
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! Test of gfortran list directed read> check delimiters are correctly ! Test of gfortran list directed read> check delimiters are correctly
! treated. Written in f77 so that g77 will run for comparison. ! treated. Written in f77 so that g77 will run for comparison.
! !
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR25307 Check handling of end-of-file conditions for list directed reads. ! PR25307 Check handling of end-of-file conditions for list directed reads.
! Prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
program pr25307 program pr25307
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR33400 Formatted read fails if line ends without line break ! PR33400 Formatted read fails if line ends without line break
! Test case modified from that in PR by <jvdelisle@gcc.gnu.org> ! Test case modified from that in PR by <jvdelisle@gcc.gnu.org>
integer, parameter :: fgsl_strmax = 128 integer, parameter :: fgsl_strmax = 128
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR34676 IO error delayed ! PR34676 IO error delayed
! Test case from PR modified by <jvdelisle@gcc.gnu.org> ! Test case from PR modified by <jvdelisle@gcc.gnu.org>
implicit none implicit none
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! pr37083 formatted read of line without trailing new-line fails ! pr37083 formatted read of line without trailing new-line fails
real :: a, b, c real :: a, b, c
open(unit=10,file="atest",access='stream',form='unformatted',& open(unit=10,file="atest",access='stream',form='unformatted',&
......
!{ dg-do run { target fd_truncate } } !{ dg-do run }
! Tests simple derived types. ! Tests simple derived types.
! Provided by Paul Thomas - pault@gcc.gnu.org ! Provided by Paul Thomas - pault@gcc.gnu.org
......
!{ dg-do run { target fd_truncate } } !{ dg-do run }
! Tests various combinations of intrinsic types, derived types, arrays, ! Tests various combinations of intrinsic types, derived types, arrays,
! dummy arguments and common to check nml_get_addr_expr in trans-io.c. ! dummy arguments and common to check nml_get_addr_expr in trans-io.c.
! See comments below for selection. ! See comments below for selection.
......
!{ dg-do run { target fd_truncate } } !{ dg-do run }
! Tests arrays of derived types containing derived type arrays whose ! Tests arrays of derived types containing derived type arrays whose
! components are character arrays - exercises object name parser in ! components are character arrays - exercises object name parser in
! list_read.c. Checks that namelist output can be reread. ! list_read.c. Checks that namelist output can be reread.
......
!{ dg-do run { target fd_truncate } } !{ dg-do run }
! Tests namelist on complex variables ! Tests namelist on complex variables
! provided by Paul Thomas - pault@gcc.gnu.org ! provided by Paul Thomas - pault@gcc.gnu.org
program namelist_16 program namelist_16
......
!{ dg-do run { target fd_truncate } } !{ dg-do run }
! Tests namelist on logical variables ! Tests namelist on logical variables
! provided by Paul Thomas - pault@gcc.gnu.org ! provided by Paul Thomas - pault@gcc.gnu.org
......
!{ dg-do run { target fd_truncate } } !{ dg-do run }
! Tests character delimiters for namelist write ! Tests character delimiters for namelist write
! provided by Paul Thomas - pault@gcc.gnu.org ! provided by Paul Thomas - pault@gcc.gnu.org
......
!{ dg-do run { target fd_truncate } } !{ dg-do run }
! Test namelist error trapping. ! Test namelist error trapping.
! provided by Paul Thomas - pault@gcc.gnu.org ! provided by Paul Thomas - pault@gcc.gnu.org
......
!{ dg-do run { target fd_truncate } } !{ dg-do run }
! Tests namelist io for an explicit shape array with negative bounds ! Tests namelist io for an explicit shape array with negative bounds
! provided by Paul Thomas - pault@gcc.gnu.org ! provided by Paul Thomas - pault@gcc.gnu.org
......
!{ dg-do run { target fd_truncate } } !{ dg-do run }
!{ dg-options -std=gnu } !{ dg-options -std=gnu }
! Tests namelist read when more data is provided then specified by ! Tests namelist read when more data is provided then specified by
! array qualifier in list. ! array qualifier in list.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR30918 Failure to skip commented out NAMELIST ! PR30918 Failure to skip commented out NAMELIST
! Before the patch, this read the commented out namelist and iuse would ! Before the patch, this read the commented out namelist and iuse would
! equal 2 when done. Test case from PR. ! equal 2 when done. Test case from PR.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR31052 Bad IOSTAT values when readings NAMELISTs past EOF. ! PR31052 Bad IOSTAT values when readings NAMELISTs past EOF.
! Patch derived from PR, submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Patch derived from PR, submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
program gfcbug61 program gfcbug61
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR31052 Bad IOSTAT values when readings NAMELISTs past EOF. ! PR31052 Bad IOSTAT values when readings NAMELISTs past EOF.
! Patch derived from PR, submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Patch derived from PR, submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
program gfcbug61 program gfcbug61
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR33039 Read NAMELIST: reads wrong namelist name ! PR33039 Read NAMELIST: reads wrong namelist name
! Test case from PR modified by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Test case from PR modified by Jerry DeLisle <jvdelisle@gcc.gnu.org>
PROGRAM namelist PROGRAM namelist
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR33253 namelist: reading back a string, also fixed writing with delimiters. ! PR33253 namelist: reading back a string, also fixed writing with delimiters.
! Test case modified from that of the PR by ! Test case modified from that of the PR by
! Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Jerry DeLisle <jvdelisle@gcc.gnu.org>
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR33421 and PR33253 Weird quotation of namelist output of character arrays ! PR33421 and PR33253 Weird quotation of namelist output of character arrays
! Test case from Toon Moone, adapted by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Test case from Toon Moone, adapted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR33672 Additional runtime checks needed for namelist reads ! PR33672 Additional runtime checks needed for namelist reads
! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options "-mieee" { target alpha*-*-* sh*-*-* } } ! { dg-options "-mieee" { target alpha*-*-* sh*-*-* } }
! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } } ! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
! !
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! !
! PR fortran/34530 ! PR fortran/34530
! !
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR35617 read namelist error with '!' ! PR35617 read namelist error with '!'
program test program test
character(len=128) :: mhdpath character(len=128) :: mhdpath
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR35627 Namelist read problem with short logical followed by read real ! PR35627 Namelist read problem with short logical followed by read real
program test program test
implicit none implicit none
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
module nml_47 module nml_47
type :: mt type :: mt
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options "-fbackslash" } ! { dg-options "-fbackslash" }
! PR36538 namelist failure with tabs preceding object name ! PR36538 namelist failure with tabs preceding object name
program check1 program check1
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options "-fbackslash" } ! { dg-options "-fbackslash" }
! PR36546 Namelist error with tab following a comma and newline ! PR36546 Namelist error with tab following a comma and newline
program check1 program check1
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR36657 Namelist string constant immediately followed by comment ! PR36657 Namelist string constant immediately followed by comment
program gfcbug79 program gfcbug79
implicit none implicit none
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR36676 Namelist comment problems ! PR36676 Namelist comment problems
! test case from PR, reduced by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! test case from PR, reduced by Jerry DeLisle <jvdelisle@gcc.gnu.org>
program mem_nml program mem_nml
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR36582 Namelist I/O error: Bogus "Cannot match namelist object" ! PR36582 Namelist I/O error: Bogus "Cannot match namelist object"
! Test case derived from PR. ! Test case derived from PR.
module mod1 module mod1
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR37707 Namelist read of array of derived type incorrect ! PR37707 Namelist read of array of derived type incorrect
! Test case from Tobias Burnus ! Test case from Tobias Burnus
IMPLICIT NONE IMPLICIT NONE
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options "-O0" } ! { dg-options "-O0" }
! Test patch for PR24416.f90 - a used to come back from the read with var ! Test patch for PR24416.f90 - a used to come back from the read with var
! prepended. ! prepended.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! This tests the fix for PR22010, where namelists were not being written to ! This tests the fix for PR22010, where namelists were not being written to
! and read back from modules. It has two namelists: one that is USE ! and read back from modules. It has two namelists: one that is USE
! associated and another that is concatenated by USE and host association. ! associated and another that is concatenated by USE and host association.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! This tests the fix for PR22010, where namelists were not being written to ! This tests the fix for PR22010, where namelists were not being written to
! and read back from modules. It checks that namelists from modules that are ! and read back from modules. It checks that namelists from modules that are
! selected by an ONLY declaration work correctly, even when the variables in ! selected by an ONLY declaration work correctly, even when the variables in
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 20774: Handle size parameter for non-advancing I/O correctly ! PR 20774: Handle size parameter for non-advancing I/O correctly
program main program main
open(77,status='scratch') open(77,status='scratch')
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! Testcase for the GNU extension OPEN(...,ACCESS="APPEND") ! Testcase for the GNU extension OPEN(...,ACCESS="APPEND")
open (10,file="foo") open (10,file="foo")
close (10,status="delete") close (10,status="delete")
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! Test correct operation for pad='no'. ! Test correct operation for pad='no'.
program main program main
character(len=1) line(2) character(len=1) line(2)
......
c { dg-do run { target fd_truncate } } c { dg-do run }
c pr 12884 c pr 12884
c test namelist with input file containg / before namelist. Also checks c test namelist with input file containg / before namelist. Also checks
c non-standard use of $ instead of & c non-standard use of $ instead of &
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! pr 17090 Runtime I/O error ! pr 17090 Runtime I/O error
! bdavis9659@comcast.net ! bdavis9659@comcast.net
! 9/12/2004 ! 9/12/2004
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! pr 17285 ! pr 17285
! Test that namelist can read its own output. ! Test that namelist can read its own output.
! At the same time, check arrays and different terminations ! At the same time, check arrays and different terminations
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR17286 ! PR17286
! Namelist read failed when spaces exist between the '=' and the numbers ! Namelist read failed when spaces exist between the '=' and the numbers
! This is a libgfortran bug ! This is a libgfortran bug
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! test namelist with scalars and arrays. ! test namelist with scalars and arrays.
! Based on example provided by thomas.koenig@online.de ! Based on example provided by thomas.koenig@online.de
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! Names in upper case and object names starting column 2 ! Names in upper case and object names starting column 2
! Based on example provided by thomas.koenig@online.de ! Based on example provided by thomas.koenig@online.de
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! pr 18392 ! pr 18392
! test namelist with derived types ! test namelist with derived types
! Based on example provided by thomas.koenig@online.de ! Based on example provided by thomas.koenig@online.de
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! !
! PR libfortran/19155 ! PR libfortran/19155
! We accept 'E+00' as a valid real number. The standard says it is not, ! We accept 'E+00' as a valid real number. The standard says it is not,
......
! PR libfortran/19216 ! PR libfortran/19216
! { dg-do run { target fd_truncate } } ! { dg-do run }
integer dat(3), i, j integer dat(3), i, j
data dat / 3,2,1 / data dat / 3,2,1 /
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! pr 19467 ! pr 19467
! test namelist with character arrays ! test namelist with character arrays
! Based on example provided by paulthomas2@wanadoo.fr ! Based on example provided by paulthomas2@wanadoo.fr
......
c { dg-do run { target fd_truncate } } c { dg-do run }
c pr 19657 c pr 19657
c test namelist not skipped if ending with logical. c test namelist not skipped if ending with logical.
c Based on example provided by fuyuki@ccsr.u-tokyo.ac.jp c Based on example provided by fuyuki@ccsr.u-tokyo.ac.jp
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-skip-if "Too big for local store" { spu-*-* } { "*" } { "" } } ! { dg-skip-if "Too big for local store" { spu-*-* } { "*" } { "" } }
integer,parameter :: n = 10000 integer,parameter :: n = 10000
real(8) array(10000) real(8) array(10000)
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR27138 Failure to advance line on bad list directed read. ! PR27138 Failure to advance line on bad list directed read.
! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
program test program test
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR25835 Check that reading from a file that is at end-of-file does not ! PR25835 Check that reading from a file that is at end-of-file does not
! segfault or give error. Test case derived from example in PR from Dale Ranta. ! segfault or give error. Test case derived from example in PR from Dale Ranta.
! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 27575 and PR 30009: This test checks the error checking for end ! PR 27575 and PR 30009: This test checks the error checking for end
! of file condition. ! of file condition.
! Derived from test case in PR. ! Derived from test case in PR.
......
!{ dg-do run { target fd_truncate } } !{ dg-do run }
! PR26423 Large file I/O error related to buffering ! PR26423 Large file I/O error related to buffering
! Test case derived from case by Dale Ranta. ! Test case derived from case by Dale Ranta.
! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! pr24719, non-advancing read should read more than one line ! pr24719, non-advancing read should read more than one line
! test contributed by jerry delisle <jvdelisle@gcc.gnu.org> ! test contributed by jerry delisle <jvdelisle@gcc.gnu.org>
implicit none implicit none
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR39528 repeated entries not read when using list-directed input. ! PR39528 repeated entries not read when using list-directed input.
! Test case derived from reporters example. ! Test case derived from reporters example.
program rread program rread
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR26890 Test for use of SIZE variable in IO list. ! PR26890 Test for use of SIZE variable in IO list.
! Test case from Paul Thomas. ! Test case from Paul Thomas.
! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options -w } ! { dg-options -w }
! PR 26661 : Test reading X's past file end with no LF or CR. ! 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. ! PR 26880 : Tests that rewind clears the gfc_unit read_bad flag.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options "-frecord-marker=4" } ! { dg-options "-frecord-marker=4" }
program main program main
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options "-frecord-marker=8" } ! { dg-options "-frecord-marker=8" }
program main program main
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! Check that rewind doesn't delete a file. ! Check that rewind doesn't delete a file.
! Writing to the file truncates it at the end of the current record. Out ! Writing to the file truncates it at the end of the current record. Out
! IO library was defering the actual truncation until the file was rewound. ! IO library was defering the actual truncation until the file was rewound.
......
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
! Contributor Francois-Xavier Coudert <coudert@clipper.ens.fr> ! Contributor Francois-Xavier Coudert <coudert@clipper.ens.fr>
! !
! { dg-options "-pedantic" } ! { dg-options "-pedantic" }
! { dg-do run { target fd_truncate } } ! { dg-do run }
! !
character*5 c character*5 c
open (42,status='scratch') open (42,status='scratch')
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 34980 - we got a segfault for calling shape ! PR 34980 - we got a segfault for calling shape
! with a scalar. ! with a scalar.
program main program main
......
! PR libfortran/22170 ! PR libfortran/22170
! { dg-do run { target fd_truncate } } ! { dg-do run }
integer i integer i
open (10,status='scratch') open (10,status='scratch')
write (10,'(A,2/,A)') '12', '17' write (10,'(A,2/,A)') '12', '17'
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-skip-if "" { *-*-mingw* spu-*-* } { "*" } { "" } } ! { dg-skip-if "" { *-*-mingw* spu-*-* } { "*" } { "" } }
! { dg-options "-std=gnu" } ! { dg-options "-std=gnu" }
character(len=*), parameter :: f = "testfile" character(len=*), parameter :: f = "testfile"
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-skip-if "" { *-*-mingw* spu-*-* } { "*" } { "" } } ! { dg-skip-if "" { *-*-mingw* spu-*-* } { "*" } { "" } }
! { dg-options "-std=gnu" } ! { dg-options "-std=gnu" }
character(len=*), parameter :: f = "testfile" character(len=*), parameter :: f = "testfile"
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR29277 Stream IO test 11, tests formatted form. ! PR29277 Stream IO test 11, tests formatted form.
! Contributed by Tobias Burnas. ! Contributed by Tobias Burnas.
program stream_test program stream_test
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR25828 Stream IO test 3, tests read_x and inquire. ! PR25828 Stream IO test 3, tests read_x and inquire.
! Contributed by Jerry DeLisle <jvdelisle@verizon.net>. ! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
program streamio_3 program streamio_3
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR25828 Stream IO test 4, Tests string read and writes, single byte. ! PR25828 Stream IO test 4, Tests string read and writes, single byte.
! Verifies buffering is working correctly and position="append" ! Verifies buffering is working correctly and position="append"
! Contributed by Jerry DeLisle <jvdelisle@verizon.net>. ! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR29053 Stream IO test 9. ! PR29053 Stream IO test 9.
! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>. ! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>.
! Test case derived from that given in PR by Steve Kargl. ! Test case derived from that given in PR by Steve Kargl.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! Test of fix to bug triggered by NIST fm908.for. ! Test of fix to bug triggered by NIST fm908.for.
! Left tabbing, followed by X or T-tabbing to the right would ! Left tabbing, followed by X or T-tabbing to the right would
! cause spaces to be overwritten on output data. ! cause spaces to be overwritten on output data.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options "-pedantic" } ! { dg-options "-pedantic" }
! This test verifies the most basic sequential unformatted I/O ! This test verifies the most basic sequential unformatted I/O
! with convert="swap". ! with convert="swap".
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
program main program main
complex(kind=4) :: c complex(kind=4) :: c
real(kind=4) :: a(2) real(kind=4) :: a(2)
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR31880 silent data corruption in gfortran read statement ! PR31880 silent data corruption in gfortran read statement
! Test from PR. ! Test from PR.
program r3 program r3
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 29627 - partial reads of unformatted records ! PR 29627 - partial reads of unformatted records
program main program main
character a(3) character a(3)
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options "-fbackslash" } ! { dg-options "-fbackslash" }
! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
program test1 program test1
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! { dg-options "-fbackslash" } ! { dg-options "-fbackslash" }
! Contributed by Tobias Burnus ! Contributed by Tobias Burnus
program test2 program test2
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! Wide chracter I/O test 1, formatted and mixed kind ! Wide chracter I/O test 1, formatted and mixed kind
! Test case developed by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Test case developed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
program test1 program test1
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR29936 Missed constraint on RECL=specifier in unformatted sequential WRITE ! PR29936 Missed constraint on RECL=specifier in unformatted sequential WRITE
! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
program us_recl program us_recl
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 26499 Test write with rewind sequences to make sure buffering and ! PR 26499 Test write with rewind sequences to make sure buffering and
! end-of-file conditions are handled correctly. Derived from test case by Dale ! end-of-file conditions are handled correctly. Derived from test case by Dale
! Ranta. Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>. ! Ranta. Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>.
......
! { dg-do run { target fd_truncate } } ! { dg-do run }
! PR 34887 - reverse tabs followed by a slash used to confuse I/O. ! PR 34887 - reverse tabs followed by a slash used to confuse I/O.
program main program main
character(len=2) :: b, a character(len=2) :: b, a
......
2009-04-30 Janne Blomqvist <jb@gcc.gnu.org>
PR libfortran/39667
* io/file_pos.c (st_rewind): Don't truncate or flush.
* io/intrinsics.c (fgetc): Flush if switching mode.
(fputc): Likewise.
2009-04-18 Janne Blomqvist <jb@gcc.gnu.org> 2009-04-18 Janne Blomqvist <jb@gcc.gnu.org>
PR libfortran/39782 PR libfortran/39782
......
...@@ -341,26 +341,8 @@ st_rewind (st_parameter_filepos *fpp) ...@@ -341,26 +341,8 @@ st_rewind (st_parameter_filepos *fpp)
u->previous_nonadvancing_write = 0; u->previous_nonadvancing_write = 0;
/* Flush the buffers. If we have been writing to the file, the last
written record is the last record in the file, so truncate the
file now. Reset to read mode so two consecutive rewind
statements do not delete the file contents. */
if (u->mode == WRITING)
{
/* unit_truncate takes care of flushing. */
unit_truncate (u, stell (u->s), &fpp->common);
/* .. but we still need to reset since we're going to seek. */
fbuf_reset (u); fbuf_reset (u);
}
else
{
/* Make sure buffers are reset. */
if (u->flags.form == FORM_FORMATTED)
fbuf_reset (u);
sflush (u->s);
}
u->mode = READING;
u->last_record = 0; u->last_record = 0;
if (sseek (u->s, 0, SEEK_SET) < 0) if (sseek (u->s, 0, SEEK_SET) < 0)
......
...@@ -46,6 +46,13 @@ PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len) ...@@ -46,6 +46,13 @@ PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len)
if (u == NULL) if (u == NULL)
return -1; return -1;
fbuf_reset (u);
if (u->mode == WRITING)
{
sflush (u->s);
u->mode = READING;
}
memset (c, ' ', c_len); memset (c, ' ', c_len);
ret = sread (u->s, c, 1); ret = sread (u->s, c, 1);
unlock_unit (u); unlock_unit (u);
...@@ -118,6 +125,13 @@ PREFIX(fputc) (const int * unit, char * c, ...@@ -118,6 +125,13 @@ PREFIX(fputc) (const int * unit, char * c,
if (u == NULL) if (u == NULL)
return -1; return -1;
fbuf_reset (u);
if (u->mode == READING)
{
sflush (u->s);
u->mode = WRITING;
}
s = swrite (u->s, c, 1); s = swrite (u->s, c, 1);
unlock_unit (u); unlock_unit (u);
if (s < 0) if (s < 0)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment