gcc/testsuite/gfortran.dg/inquire_5.f90

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