OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [direct_io_10.f] - Blame information for rev 715

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

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! pr35699 run-time abort writing zero sized section to direct access file
3
      program directio
4
      call       qi0010 (  10,   1,   2,   3,   4,  9,   2)
5
      end
6
 
7
      subroutine qi0010 (nf10, nf1, nf2, nf3, nf4,nf9, np2)
8
      character(10) bda(nf10)
9
      character(10) bda1(nf10), bval
10
 
11
      integer  j_len
12
      bda1(1) = 'x'
13
      do i = 2,10
14
        bda1(i) = 'x'//bda1(i-1)
15
      enddo
16
      bda = 'unread'
17
 
18
      inquire(iolength = j_len) bda1(nf1:nf10:nf2), bda1(nf4:nf3),
19
     $                               bda1(nf2:nf10:nf2)
20
 
21
      open (unit=48,
22
     $      access='direct',
23
     $      status='scratch',
24
     $      recl = j_len,
25
     $      iostat = istat,
26
     $      form='unformatted',
27
     $      action='readwrite')
28
 
29
      write (48,iostat = istat, rec = 3) bda1(nf1:nf10:nf2),
30
     $                    bda1(nf4:nf3), bda1(nf2:nf10:nf2)
31
      if ( istat .ne. 0) then
32
        call abort
33
      endif
34
      istat = -314
35
 
36
      read (48,iostat = istat, rec = np2+1) bda(nf1:nf9:nf2),
37
     $                       bda(nf4:nf3), bda(nf2:nf10:nf2)
38
      if ( istat .ne. 0) then
39
        call abort
40
      endif
41
 
42
      do j1 = 1,10
43
        bval = bda1(j1)
44
        if (bda(j1) .ne. bval) call abort
45
      enddo
46
      end subroutine

powered by: WebSVN 2.1.0

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