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