1! { dg-do run { target fd_truncate } }
2! { dg-options "-fdec" }
3!
4! Run-time tests for values of DEC I/O parameters (doesn't test functionality).
5!
6
7subroutine check_cc (fd, cc)
8  implicit none
9  character(*), intent(in) :: cc
10  integer, intent(in) :: fd
11  character(20) :: cc_inq
12  inquire(unit=fd, carriagecontrol=cc_inq)
13  if (cc_inq .ne. cc) then
14    print *, '(', fd, ') cc expected ', cc, ' was ', cc_inq
15    STOP 1
16  endif
17endsubroutine
18
19subroutine check_share (fd, share)
20  implicit none
21  character(*), intent(in) :: share
22  integer, intent(in) :: fd
23  character(20) :: share_inq
24  inquire(unit=fd, share=share_inq)
25  if (share_inq .ne. share) then
26    print *, '(', fd, ') share expected ', share, ' was ', share_inq
27    STOP 2
28  endif
29endsubroutine
30
31subroutine check_action (fd, acc)
32  implicit none
33  character(*), intent(in) :: acc
34  integer, intent(in) :: fd
35  character(20) acc_inq
36  inquire(unit=fd, action=acc_inq)
37  if (acc_inq .ne. acc) then
38    print *, '(', fd, ') access expected ', acc, ' was ', acc_inq
39    STOP 3
40  endif
41endsubroutine
42
43implicit none
44
45integer, parameter :: fd=3
46character(*), parameter :: fname  = 'dec_io_1.txt'
47
48!!!! <default>
49
50open(unit=fd,  file=fname, action='WRITE')
51call check_cc(fd, 'LIST')
52call check_share(fd, 'NODENY')
53write (fd,*) 'test'
54close(unit=fd)
55
56!!!! READONLY
57
58open (unit=fd, file=fname, readonly)
59call check_action(fd, 'READ')
60close (unit=fd)
61
62!!!! SHARED / SHARE='DENYNONE'
63
64open (unit=fd, file=fname, action='read', shared)
65call check_share(fd, 'DENYNONE')
66close (unit=fd)
67
68open (unit=fd, file=fname, action='read', share='DENYNONE')
69call check_share(fd, 'DENYNONE')
70close (unit=fd)
71
72!!!! NOSHARED / SHARE='DENYRW'
73
74open (unit=fd, file=fname, action='write', noshared)
75call check_share(fd, 'DENYRW')
76close (unit=fd)
77
78open (unit=fd, file=fname, action='write', share='DENYRW')
79call check_share(fd, 'DENYRW')
80close (unit=fd)
81
82!!!! CC=FORTRAN
83
84open(unit=fd,  file=fname, action ='WRITE', carriagecontrol='FORTRAN')
85call check_cc(fd, 'FORTRAN')
86close(unit=fd)
87
88!!!! CC=LIST
89
90open(unit=fd,  file=fname, action ='WRITE', carriagecontrol='LIST')
91call check_cc(fd, 'LIST')
92close(unit=fd)
93
94!!!! CC=NONE
95
96open(unit=fd,  file=fname, action ='WRITE', carriagecontrol='NONE')
97call check_cc(fd, 'NONE')
98close(unit=fd, status='delete') ! cleanup temp file
99
100
101end
102