gcc/testsuite/gfortran.dg/direct_io_9.f

   1 ! { dg-do run }
   2 ! PR34876 can't read/write zero length array sections
   3 ! Test case from PR by Dick Hendrikson
   4       program qi0011
   5       character(9) bda(10)
   6       character(9) bda1(10)
   7       integer  j_len
   8       istat = -314
   9
  10       inquire(iolength = j_len) bda1
  11
  12       istat = -314
  13       open (unit=48,
  14      $      status='scratch',
  15      $      access='direct',
  16      $      recl = j_len,
  17      $      iostat = istat,
  18      $      form='unformatted',
  19      $      action='readwrite')
  20
  21
  22       if (istat /= 0) call abort
  23
  24       bda  = 'xxxxxxxxx'
  25       bda1 = 'yyyyyyyyy'
  26       write (48,iostat = istat, rec = 10) bda1(4:3)
  27       if ( istat .ne. 0) then
  28         call abort
  29       endif
  30
  31       istat = -314
  32       read (48,iostat = istat, rec=10) bda(4:3)
  33       if ( istat .ne. 0) then
  34         call abort
  35       endif
  36       if (any(bda1.ne.'yyyyyyyyy')) call abort
  37       if (any(bda.ne.'xxxxxxxxx')) call abort
  38       end
  39