1#
2# process.test
3#
4# Tests for the fork, execl and  wait commands.
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: process.test,v 1.4 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
23test process-1.1.pc {fork, execl, wait tests} {pcOnly} {
24    removeFile script
25    makeFile {after 1000;update;exit 12} script
26    set newPid [execl $::tcltest::tcltest script]
27    lrange [wait $newPid] 1 end
28} {EXIT 12}
29
30if {[cequal $tcl_platform(platform) windows]} { ;# WIN32???
31    echo process win32 work not completed, tests skipped.
32    return
33}
34
35#
36# Fork without exec will not work under Tk, skip this test
37#
38if {[info exists tk_version]} {
39    puts "*************************************************************"
40    puts "Process tests are constructed in a way that does not work"
41    puts "under Tk.  Test skipped."
42    puts "*************************************************************"
43    return
44}
45
46# Test fork, execl, and wait commands.
47
48test process-1.1.unix {fork, execl, wait tests} {unixOnly} {
49    set newPid [fork]
50    if {$newPid == 0} {
51	removeFile script
52	makeFile {after 1000;update;exit 12} script
53        catch {execl $::tcltest::tcltest script} msg
54        puts stderr "execl failed 1.1: $msg"
55        exit 1
56    }
57    lrange [wait $newPid] 1 end
58} {EXIT 12}
59
60test process-1.2 {fork, execl, wait tests} {
61    set newPid [ForkLoopingChild]
62    sleep 1
63
64    kill $newPid
65    lrange [wait $newPid] 1 end
66} {SIG SIGTERM}
67
68set newPid1 [ForkLoopingChild]
69set newPid2 [ForkLoopingChild]
70
71test process-1.3 {fork, execl, wait tests} {
72    sleep 3 ;# Give em a chance to get going.
73
74    kill [list $newPid1 $newPid2]
75    list [wait $newPid1] [wait $newPid2]
76} [list "$newPid1 SIG SIGTERM" "$newPid2 SIG SIGTERM"]
77
78test process-1.4 {fork, execl, wait tests} {
79    list [catch {fork foo} msg] $msg
80} {1 {wrong # args: fork}}
81
82test process-1.5 {fork, execl, wait tests} {
83    list [catch {wait baz} msg] $msg
84} {1 {invalid pid or process group id "baz"}}
85
86test process-1.6 {fork, execl, wait tests} {
87    set testPid [ForkLoopingChild]
88    kill $testPid
89    set result [wait $testPid]
90    lrange $result 1 end
91} {SIG SIGTERM}
92
93test process-1.7 {fork, execl, wait tests} {unixOnly} {
94    set newPid [fork]
95    if {$newPid == 0} {
96	set script "sleep 1; if test \"\$0\" = \"FOOPROC\"; then\n\
97		exit 10;\nfi\nexit 18;"
98        catch [list execl -argv0 FOOPROC /bin/sh [list -c $script]] msg
99        puts stderr "execl failed 1.7: $msg"
100        exit 1
101    }
102    lrange [wait $newPid] 1 end
103} {EXIT 10}
104
105# Try execl in various wrong ways.  We try it in a separate process, first,
106# in case by error we exec something.
107
108Test process-1.8 {fork, execl, wait tests} {
109    set newPid [fork]
110    if {$newPid == 0} {
111	catch {execl -argv0 FOOPROC}
112	exit 24
113    }
114    if {[lrange [wait $newPid] 1 end] == {EXIT 24}} {
115	execl -argv0 FOOPROC
116    } else {
117        concat "appears to have exec-ed something"
118    }
119} 1 {wrong # args: execl ?-argv0 argv0? prog ?argList?}
120
121Test process-1.9 {fork, execl, wait tests} {
122    removeFile script
123    makeFile {exit 0} {script}
124    set newPid [fork]
125    if {$newPid == 0} {
126	catch {execl -argv0 FOOPROC $::tcltest::tcltest script badarg}
127	exit 23
128    }
129    if {[lrange [wait $newPid] 1 end] == {EXIT 23}} {
130	execl -argv0 FOOPROC $::tcltest::tcltest script badarg
131    } else {
132        concat "appears to have exec-ed something"
133    }
134} 1 {wrong # args: execl ?-argv0 argv0? prog ?argList?}
135
136Test process-1.10 {fork, execl, wait tests} {
137    removeFile script
138    makeFile {exit 0} {script}
139    set newPid [fork]
140    if {$newPid == 0} {
141	catch {execl $::tcltest::tcltest script badarg}
142	exit 24
143    }
144    sleep 1
145    if {[lrange [wait $newPid] 1 end] == {EXIT 24}} {
146	execl $::tcltest::tcltest script badarg
147    }
148} 1 {wrong # args: execl ?-argv0 argv0? prog ?argList?}
149
150Test process-1.11 {fork, execl, wait tests} {
151    set newPid [fork]
152    if {$newPid == 0} {
153	catch {execl}
154	exit 24
155    }
156    sleep 1
157    if {[lrange [wait $newPid] 1 end] == {EXIT 24}} {
158	execl
159    } else {
160        concat "appears to have exec-ed something"
161    }
162} 1 {wrong # args: execl ?-argv0 argv0? prog ?argList?}
163
164Test process-1.12 {fork, execl, wait tests} {
165    set newPid [fork]
166    if {$newPid == 0} {
167	catch {execl -argv0}
168	exit 24
169    }
170    sleep 1
171    if {[lrange [wait $newPid] 1 end] == {EXIT 24}} {
172	execl -argv0
173    } else {
174        concat "appears to have exec-ed something"
175    }
176} 1 {wrong # args: execl ?-argv0 argv0? prog ?argList?}
177
178# Test extended wait functionality, if available.
179
180test process-2.1 {fork, execl, wait tests} {need_waitpid} {
181    set testPid [ForkLoopingChild]
182    set result1 [wait -nohang $testPid]
183    kill $testPid
184    set result2 [wait $testPid]
185    list $result1 [lrange $result2 1 end]
186} {{} {SIG SIGTERM}}
187
188test process-2.2 {fork, execl, wait tests} {need_waitpid} {
189    set testPid [ForkLoopingChild 1]
190    set result1 [wait -nohang -pgroup $testPid]
191    kill $testPid
192    set result2 [wait -pgroup $testPid]
193    list $result1 [lrange $result2 1 end]
194} {{} {SIG SIGTERM}}
195
196test process-2.3 {fork, execl, wait tests} {need_waitpid} {
197    set testPid [ForkLoopingChild 1]
198    set result1 [wait -nohang -pgroup -untraced $testPid]
199    kill $testPid
200    set result2 [wait -pgroup -untraced $testPid]
201    list $result1 [lrange $result2 1 end]
202} {{} {SIG SIGTERM}}
203
204
205# cleanup
206::tcltest::cleanupTests
207return
208