OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [inquire_13.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { 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  
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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.