gcc/testsuite/gfortran.dg/inquire_13.f90

   1 ! { dg-do run }
   2 ! PR34795 inquire statement , direct= specifier incorrectly returns YES
   3 ! Test case from PR, modified by Jerry DeLisle  <jvdelisle@gcc.gnu.org
   4 program testinquire
   5 implicit none
   6 character drct*7, acc*12, frmt*12, seqn*12, fname*15
   7 logical opn
   8
   9 fname="inquire_13_test"
  10 inquire(unit=6, direct=drct, opened=opn, access=acc)
  11 if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
  12
  13 inquire(unit=10, direct=drct, opened=opn, access=acc)
  14 if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
  15
  16 inquire(unit=10, direct=drct, opened=opn, access=acc, formatted=frmt)
  17 if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
  18 if (frmt.ne."UNKNOWN") call abort
  19
  20 open(unit=19,file=fname,status='replace',err=170,form="formatted")
  21 inquire(unit=19, direct=drct, opened=opn, access=acc,formatted=frmt)
  22 if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL")  call abort
  23 if (frmt.ne."YES")  call abort
  24
  25 ! Inquire on filename, open file with DIRECT and FORMATTED
  26 inquire(file=fname, direct=drct, opened=opn, access=acc, FORMATTED=frmt)
  27 if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL")  call abort
  28 if (frmt.ne."YES") call abort
  29 close(19)
  30
  31 ! Inquire on filename, closed file with DIRECT and FORMATTED
  32 inquire(file=fname, direct=drct, opened=opn, access=acc, formatted=frmt)
  33 if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
  34 if (frmt.ne."UNKNOWN") call abort
  35
  36 open(unit=19,file=fname,status='replace',err=170,form="unformatted")
  37 inquire(unit=19, direct=drct, opened=opn, access=acc, formatted=frmt)
  38 if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
  39 if (frmt.ne."NO")  call abort
  40 close(19)
  41
  42 open(unit=19,file=fname,status='replace',err=170,form="formatted")
  43
  44 inquire(unit=19, direct=drct, opened=opn, access=acc, unformatted=frmt)
  45 if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
  46
  47 ! Inquire on filename, open file with DIRECT and UNFORMATTED
  48 inquire(file=fname, direct=drct, opened=opn, access=acc, UNFORMATTED=frmt)
  49 if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL")  call abort
  50 if (frmt.ne."NO") call abort
  51 close(19)
  52
  53 ! Inquire on filename, closed file with DIRECT and UNFORMATTED
  54 inquire(file=fname, direct=drct, opened=opn, access=acc, unformatted=frmt)
  55 if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
  56 if (frmt.ne."UNKNOWN") call abort
  57
  58 open(unit=19,file=fname,status='replace',err=170,form="unformatted")
  59
  60 inquire(unit=19, direct=drct, opened=opn, access=acc,unformatted=frmt)
  61 if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
  62 if (frmt.ne."YES")  call abort
  63 close(19)
  64
  65 open(unit=19,file=fname,status='replace',err=170)
  66
  67 inquire(unit=19, direct=drct, opened=opn, access=acc)
  68 if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
  69 close(19)
  70
  71 open(unit=19,file=fname,status='replace',err=170,access='SEQUENTIAL')
  72
  73 inquire(unit=19, direct=drct, opened=opn, access=acc)
  74 if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
  75
  76 ! Inquire on filename, open file with SEQUENTIAL
  77 inquire(file=fname, SEQUENTIAL=seqn, opened=opn, access=acc)
  78 if (seqn.ne."YES" .and. .not.opn .and. acc.ne."DIRECT") call abort
  79 close(19)
  80
  81 ! Inquire on filename, closed file with SEQUENTIAL
  82 inquire(file=fname, SEQUENTIAL=seqn, opened=opn, access=acc)
  83 if (seqn.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
  84
  85 open(unit=19,file=fname,status='replace',err=170,form='UNFORMATTED',access='DIRECT',recl=72)
  86
  87 inquire(unit=19, direct=drct, opened=opn, access=acc)
  88 if (drct.ne."YES" .and. .not.opn .and. acc.ne."DIRECT") call abort
  89
  90 ! Inquire on filename, open file with DIRECT
  91 inquire(file=fname, direct=drct, opened=opn, access=acc)
  92 if (drct.ne."YES" .and. .not.opn .and. acc.ne."DIRECT") call abort
  93 close(19, status="delete")
  94
  95 ! Inquire on filename, closed file with DIRECT
  96 inquire(file=fname, direct=drct, opened=opn, access=acc)
  97 if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
  98 stop
  99
 100 170   write(*,*) "ERROR: unable to open testdirect.f"
 101 end