gcc/testsuite/gfortran.dg/inquire_5.f90

   1 ! { dg-do run { target fd_truncate } }
   2 ! pr19314 inquire(..position=..) segfaults
   3 ! test by Thomas.Koenig@online.de
   4 !         bdavis9659@comcast.net
   5       implicit none
   6       character*20 chr
   7       open(7,STATUS='SCRATCH')
   8       inquire(7,position=chr)
   9       if (chr.NE.'ASIS') CALL ABORT
  10       close(7)
  11       open(7,STATUS='SCRATCH',ACCESS='DIRECT',RECL=100)
  12       inquire(7,position=chr)
  13       if (chr.NE.'UNDEFINED') CALL ABORT
  14       close(7)
  15       open(7,STATUS='SCRATCH',POSITION='REWIND')
  16       inquire(7,position=chr)
  17       if (chr.NE.'REWIND') CALL ABORT
  18       close(7)
  19       open(7,STATUS='SCRATCH',POSITION='ASIS')
  20       inquire(7,position=chr)
  21       if (chr.NE.'ASIS') CALL ABORT
  22       close(7)
  23       open(7,STATUS='SCRATCH',POSITION='APPEND')
  24       inquire(7,position=chr)
  25       if (chr.NE.'APPEND') CALL ABORT
  26       close(7)
  27       open(7,STATUS='SCRATCH',POSITION='REWIND')
  28       write(7,*)'this is a record written to the file'
  29       write(7,*)'this is another record'
  30       backspace(7)
  31       inquire(7,position=chr)
  32       if (chr.NE.'ASIS') CALL ABORT
  33       rewind(7)
  34       inquire(7,position=chr)
  35       if (chr.NE.'REWIND') CALL ABORT
  36       close(7)
  37       end