gcc/testsuite/gfortran.dg/inquire_5.f90

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