47 lines
1.2 KiB
Fortran
47 lines
1.2 KiB
Fortran
! { dg-do run }
|
|
! pr35699 run-time abort writing zero sized section to direct access file
|
|
program directio
|
|
call qi0010 ( 10, 1, 2, 3, 4, 9, 2)
|
|
end
|
|
|
|
subroutine qi0010 (nf10, nf1, nf2, nf3, nf4,nf9, np2)
|
|
character(10) bda(nf10)
|
|
character(10) bda1(nf10), bval
|
|
|
|
integer j_len
|
|
bda1(1) = 'x'
|
|
do i = 2,10
|
|
bda1(i) = 'x'//bda1(i-1)
|
|
enddo
|
|
bda = 'unread'
|
|
|
|
inquire(iolength = j_len) bda1(nf1:nf10:nf2), bda1(nf4:nf3),
|
|
$ bda1(nf2:nf10:nf2)
|
|
|
|
open (unit=48,
|
|
$ access='direct',
|
|
$ status='scratch',
|
|
$ recl = j_len,
|
|
$ iostat = istat,
|
|
$ form='unformatted',
|
|
$ action='readwrite')
|
|
|
|
write (48,iostat = istat, rec = 3) bda1(nf1:nf10:nf2),
|
|
$ bda1(nf4:nf3), bda1(nf2:nf10:nf2)
|
|
if ( istat .ne. 0) then
|
|
call abort
|
|
endif
|
|
istat = -314
|
|
|
|
read (48,iostat = istat, rec = np2+1) bda(nf1:nf9:nf2),
|
|
$ bda(nf4:nf3), bda(nf2:nf10:nf2)
|
|
if ( istat .ne. 0) then
|
|
call abort
|
|
endif
|
|
|
|
do j1 = 1,10
|
|
bval = bda1(j1)
|
|
if (bda(j1) .ne. bval) call abort
|
|
enddo
|
|
end subroutine
|