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