1#
2# fcntl.test
3#
4# Tests for the fcntl command.
5#---------------------------------------------------------------------------
6# Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans.
7#
8# Permission to use, copy, modify, and distribute this software and its
9# documentation for any purpose and without fee is hereby granted, provided
10# that the above copyright notice appear in all copies.  Karl Lehenbauer and
11# Mark Diekhans make no representations about the suitability of this
12# software for any purpose.  It is provided "as is" without express or
13# implied warranty.
14#------------------------------------------------------------------------------
15# $Id: fcntl.test,v 1.3 2002/04/04 06:10:30 hobbs Exp $
16#------------------------------------------------------------------------------
17#
18
19if {[cequal [info procs Test] {}]} {
20    source [file join [file dirname [info script]] testlib.tcl]
21}
22
23close [open FCNTL1.TMP w]
24close [open FCNTL2.TMP w]
25close [open FCNTL3.TMP w]
26
27set testRWFH [open FCNTL1.TMP r+]
28set testRFH [open FCNTL2.TMP r]
29set testWFH [open FCNTL3.TMP w]
30
31pipe testRPH testWPH
32
33test fcntl-1.1 {fcntl tests} {
34    fcntl $testRWFH RDONLY
35} 0
36
37test fcntl-1.2 {fcntl tests} {
38    fcntl $testRWFH WRONLY
39} 0
40
41test fcntl-1.3 {fcntl tests} {
42    fcntl $testRWFH RDWR
43} 1
44
45test fcntl-1.4 {fcntl tests} {
46    fcntl $testRWFH READ
47} 1
48
49test fcntl-1.5 {fcntl tests} {
50    fcntl $testRWFH WRITE
51} 1
52
53
54test fcntl-1.6 {fcntl tests} {
55    fcntl $testRFH RDONLY
56} 1
57
58test fcntl-1.7 {fcntl tests} {
59    fcntl $testRFH WRONLY
60} 0
61
62test fcntl-1.8 {fcntl tests} {
63    fcntl $testRFH RDWR
64} 0
65
66test fcntl-1.9 {fcntl tests} {
67    fcntl $testRFH READ
68} 1
69
70test fcntl-1.10 {fcntl tests} {
71    fcntl $testRFH WRITE
72} 0
73
74
75test fcntl-1.11 {fcntl tests} {
76    fcntl $testWFH RDONLY
77} 0
78
79test fcntl-1.12 {fcntl tests} {
80    fcntl $testWFH WRONLY
81} 1
82
83test fcntl-1.13 {fcntl tests} {
84    fcntl $testWFH RDWR
85} 0
86
87test fcntl-1.14 {fcntl tests} {
88    fcntl $testWFH READ
89} 0
90
91test fcntl-1.15 {fcntl tests} {
92    fcntl $testWFH WRITE
93} 1
94
95
96test fcntl-2.1 {fcntl tests} {
97    fcntl $testRWFH CLOEXEC 1
98    fcntl $testRWFH CLOEXEC
99} 1
100
101test fcntl-2.2 {fcntl tests} {
102    fcntl $testRWFH CLOEXEC 0
103    fcntl $testRWFH CLOEXEC
104} 0 
105
106test fcntl-2.3 {fcntl tests} {
107    fcntl $testRPH NONBLOCK 1
108    list [fcntl $testRPH NONBLOCK] [fconfigure $testRPH -blocking]
109} {1 0}
110
111test fcntl-2.4 {fcntl tests} unixOnly {
112    fcntl $testRWFH append 1
113    fcntl $testRWFH append
114} 1
115
116test fcntl-2.5 {fcntl tests} unixOnly {
117    fcntl $testRWFH APPEND 0
118    fcntl $testRWFH append
119} 0
120
121test fcntl-2.5.1 {fcntl tests} pcOnly {
122    list [catch {fcntl $testRWFH APPEND 0} msg] $msg
123} {1 {append mode is not available on MS Windows}}
124
125test fcntl-3.1 {fcntl tests} {
126    fcntl $testRPH NONBLOCK 0
127    list [fcntl $testRPH nonBlock] [fconfigure $testRPH -blocking]
128} {0 1}
129
130test fcntl-3.2 {fcntl tests} {
131    fcntl $testRWFH NOBUF 1
132    list [fcntl $testRWFH NObuf] [fconfigure $testRWFH -buffering]
133} {1 none}
134
135close $testRWFH
136close $testRFH
137close $testWFH
138
139# Reopen, can not have both nobuf and linebuf
140set testRWFH [open FCNTL1.TMP w]  
141
142test fcntl-4.1 {fcntl tests} {
143    fcntl $testRWFH LINEBUF 1
144    list [fcntl $testRWFH LINEBUF] [fconfigure $testRWFH -buffering]
145} {1 line}
146
147test fcntl-5.1 {fcntl tests} {
148    list [catch {fcntl $testRWFH a b c} msg] $msg
149} {1 {wrong # args: fcntl handle attribute ?value?}}
150
151test fcntl-5.2 {fcntl tests} {
152    list [catch {fcntl $testRWFH BAZ 1} msg] $msg
153} {1 {unknown attribute name "BAZ", expected one of RDONLY, WRONLY, RDWR, READ, WRITE, APPEND, CLOEXEC, NONBLOCK, LINEBUF, NOBUF, or KEEPALIVE}}
154
155test fcntl-5.3 {fcntl tests} {
156    list [catch {fcntl $testRWFH APPEND FOO} msg] $msg
157} {1 {expected boolean value but got "FOO"}}
158
159close $testRWFH
160
161test fcntl-5.4 {fcntl tests} {
162    list [catch {fcntl $testRWFH RDONLY} msg] $msg
163} [list 1 "can not find channel named \"$testRWFH\""]
164
165close $testRPH
166close $testWPH
167
168#
169# Tests for socket related controls.
170#
171set doSocketTests 0
172# FIX: Should be an explict test for NT.
173if {[cequal $tcl_platform(platform) unix] ||
174    ![cequal $tcl_platform(os) "Windows 95"]} {
175    if {[catch {close [socket [id host] echo]; set doSocketTests 1} msg]} {
176        puts "*************************************************************"
177        puts "Unable to connect to the \"echo\" server:"
178        puts "$msg."
179        puts "Some tests skipped."
180        puts "*************************************************************"
181    }
182}
183if $doSocketTests {
184    set sockFH [socket [id host] echo]
185
186    test fcntl-6.1 {fcntl socket tests} {
187        fcntl $sockFH KEEPALIVE 1
188        fcntl $sockFH KEEPALIVE
189    } 1
190
191    test fcntl-6.2 {fcntl socket tests} {
192        fcntl $sockFH KEEPALIVE 0
193        fcntl $sockFH KEEPALIVE
194    } 0
195
196    close $sockFH
197}
198
199TestRemove FCNTL1.TMP FCNTL2.TMP FCNTL3.TMP
200
201
202