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