gcc/testsuite/gfortran.dg/inquire_13.f90

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