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") STOP 1
  14
  15 inquire(unit=10, direct=drct, opened=opn, access=acc)
  16 if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") STOP 2
  17
  18 inquire(unit=10, direct=drct, opened=opn, access=acc, formatted=frmt)
  19 if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") STOP 3
  20 if (frmt.ne."UNKNOWN") STOP 4
  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")  STOP 5
  25 if (frmt.ne."YES")  STOP 6
  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")  STOP 7
  30 if (frmt.ne."YES") STOP 8
  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") STOP 9
  36 if (frmt.ne."UNKNOWN") STOP 10
  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") STOP 11
  41 if (frmt.ne."NO")  STOP 12
  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") STOP 13
  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")  STOP 14
  52 if (frmt.ne."NO") STOP 15
  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") STOP 16
  58 if (frmt.ne."UNKNOWN") STOP 17
  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") STOP 18
  64 if (frmt.ne."YES")  STOP 19
  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") STOP 20
  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") STOP 21
  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") STOP 22
  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") STOP 23
  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") STOP 24
  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") STOP 25
  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") STOP 26
 100 stop
 101
 102 170   write(*,*) "ERROR: unable to open testdirect.f"
 103 end