1# 2# pipe.test 3# 4# Tests for the pipe 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: pipe.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 23# 24# Fork without exec will not work under Tk, skip this test 25# 26if {[info exists tk_version]} { 27 puts "******************************************************************" 28 puts "The pipe commands test require fork, which does not work under Tk." 29 puts "Test skipped." 30 puts "******************************************************************" 31 return 32} 33# FIX: Need win95 tests for pipe. 34 35# 36# Create child process to read from the pipe and write a message 37# back. 38# 39proc PipeChild {id numRecs readChan} { 40 flush stdout ;# Not going to exec, must clean up the buffers. 41 flush stderr 42 set pid [fork] 43 if {$pid != 0} { 44 return $pid 45 } 46 for {set cnt 0} {$cnt < $numRecs} {incr cnt} { 47 Test filecmds-4.1 {pipe tests} { 48 if {![gets $readChan msgBuf]} { 49 set msgBuf "Premature eof on pipe" 50 set cnt $numRecs 51 } 52 set msgBuf 53 } 0 [GenRec $cnt] 54 } 55 close $readChan 56 exit 0 57} 58 59test pipe-1.1 {pipe tests} { 60 list [catch {pipe x y z} msg] $msg 61} {1 {wrong # args: pipe ?fileId_var_r fileId_var_w?}} 62 63test pipe-1.2 {pipe tests} {unixOnly} { 64 pipe readChan writeChan 65 66 set pid [PipeChild pipe-1.3 50 $readChan] 67 for {set cnt 0} {$cnt < 50} {incr cnt} { 68 puts $writeChan [GenRec $cnt] 69 } 70 flush $writeChan 71 Test pipe-1.32 {pipe tests} { 72 wait $pid 73 } 0 [list $pid EXIT 0] 74 75 close $readChan 76 close $writeChan 77} {} 78 79# cleanup 80::tcltest::cleanupTests 81return 82