OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [streamio_15.f90] - Blame information for rev 329

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do run { target fd_truncate } }
2
! PR35132 Formatted stream I/O write should truncate.
3
! Test case adapted from PR by Jerry DeLisle  
4
program main
5
  implicit none
6
  character(len=6) :: c
7
  integer :: i, newline_length
8
 
9
  open(20,status="scratch",access="stream",form="formatted")
10
  write(20,"()")
11
  inquire(20,pos=newline_length)
12
  newline_length = newline_length - 1
13
  if (newline_length < 1 .or. newline_length > 2) call abort
14
  close(20)
15
 
16
  open(20,file="foo.txt",form="formatted",access="stream")
17
  write(20,'(A)') '123456'
18
  write(20,'(A)') 'abcdef'
19
  write(20,'(A)') 'qwerty'
20
  rewind 20
21
  ! Skip over the first line
22
  read(20,'(A)') c
23
  if (c.ne.'123456') call abort
24
  ! Save the position
25
  inquire(20,pos=i)
26
  if (i.ne.7+newline_length) call abort
27
  ! Read in the complete line...
28
  read(20,'(A)') c
29
  if (c.ne.'abcdef') call abort
30
  ! Write out the first four characters
31
  write(20,'(A)',pos=i,advance="no") 'ASDF'
32
  ! Fill up the rest of the line.  Here, we know the length.  If we
33
  ! don't, things will be a bit more complicated.
34
  write(20,'(A)') c(5:6)
35
  ! Copy the file to standard output
36
  rewind 20
37
  c = ""
38
  read(20,'(A)') c
39
  if (c.ne.'123456') call abort
40
  read(20,'(A)') c
41
  if (c.ne.'ASDFef') call abort
42
  read(20,'(A)', iostat=i) c
43
  if (i /= -1) call abort
44
  close (20, status="delete")
45
end program main

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.