1# process.test -- 2# 3# This file contains a collection of tests for the tcl::process ensemble. 4# Sourcing this file into Tcl runs the tests and generates output for 5# errors. No output means no errors were found. 6# 7# Copyright © 2017 Frederic Bonnet 8# See the file "license.terms" for information on usage and redistribution of 9# this file, and for a DISCLAIMER OF ALL WARRANTIES. 10 11if {"::tcltest" ni [namespace children]} { 12 package require tcltest 2.5 13 namespace import -force ::tcltest::* 14} 15 16# Utilities 17file delete [set path(test-signalfile) [makeFile {} test-signalfile]] 18set path(test-signalfile2) [makeFile {} test-signalfile2] 19# $path(sleep) time ?filename? -- sleep for time (in ms) and stop if it gets signaled (file gets deleted) 20set path(sleep) [makeFile { 21 after [expr {[lindex $argv 0]*1000}] {set stop 1} 22 if {[set fn [lindex $::argv 1]] ne ""} { 23 close [open $fn w] 24 proc check {} { 25 if {![file exists $::fn]} { # exit signaled 26 after 10 {set ::stop 2} 27 } 28 after 10 check 29 } 30 after 10 check 31 } 32 vwait stop 33 exit 34} sleep] 35 36proc wait_for_file {fn {timeout 10000}} { 37 if {![file exists $fn]} { 38 set toev [after $timeout {set found 0}] 39 proc check {fn} { 40 if {[file exists $fn]} { 41 set ::found 1 42 return 43 } 44 after 10 [list check $fn] 45 } 46 after 10 [list check $fn] 47 vwait ::found 48 after cancel $toev 49 unset ::found 50 } 51 file exists $fn 52} 53proc signal_exit {fn {wait 1}} { 54 # wait for until file created if expected: 55 if {!$wait || [wait_for_file $fn]} { 56 # delete file to signal exit for child-process: 57 while {1} { 58 if {![catch { file delete $fn } msg opt] 59 || [lrange [dict get $opt -errorcode] 0 1] ne {POSIX EACCES} 60 } break 61 } 62 } 63} 64 65set path(exit) [makeFile { 66 exit [lindex $argv 0] 67} exit] 68 69# Basic syntax checking 70test process-1.1 {tcl::process command basic syntax} -returnCodes error -body { 71 tcl::process 72} -result {wrong # args: should be "tcl::process subcommand ?arg ...?"} 73test process-1.2 {tcl::process subcommands} -returnCodes error -body { 74 tcl::process ? 75} -match glob -result {unknown or ambiguous subcommand "?": must be autopurge, list, purge, or status} 76 77# Autopurge flag 78# - Default state 79test process-2.1 {autopurge default} -body { 80 tcl::process autopurge 81} -result {1} 82# - Enabling autopurge 83test process-2.2 {enable autopurge} -body { 84 tcl::process autopurge true 85 tcl::process autopurge 86} -result {1} 87# - Disabling autopurge 88test process-2.3 {disable autopurge} -body { 89 tcl::process autopurge false 90 tcl::process autopurge 91} -result {0} -cleanup {tcl::process autopurge true} 92 93# Subprocess list & status 94test process-3.1 {empty subprocess list} -body { 95 llength [tcl::process list] 96} -result {0} 97test process-3.2 {empty subprocess status} -body { 98 dict size [tcl::process status] 99} -result {0} 100 101# Spawn subprocesses using [exec] 102# - One child 103test process-4.1 {exec one child} -body { 104 tcl::process autopurge 0 105 set pid [exec [interpreter] $path(exit) 0 &] 106 set list [tcl::process list] 107 set statuses [tcl::process status -wait] 108 set status [lindex [tcl::process status $pid] 1] 109 expr { 110 [llength $list] eq 1 111 && [lindex $list 0] eq $pid 112 && [dict size $statuses] eq 1 113 && [dict get $statuses $pid] eq $status 114 && $status eq 0 115 } 116} -result {1} -cleanup { 117 tcl::process purge 118 tcl::process autopurge 1 119} 120# - Two children 121test process-4.2 {exec two children in parallel} -body { 122 tcl::process autopurge 0 123 set pid1 [exec [interpreter] $path(exit) 0 &] 124 set pid2 [exec [interpreter] $path(exit) 0 &] 125 set list [tcl::process list] 126 set statuses [tcl::process status -wait] 127 set status1 [lindex [tcl::process status $pid1] 1] 128 set status2 [lindex [tcl::process status $pid2] 1] 129 expr { 130 [llength $list] eq 2 131 && [lsearch $list $pid1] >= 0 132 && [lsearch $list $pid2] >= 0 133 && [dict size $statuses] eq 2 134 && [dict get $statuses $pid1] eq $status1 135 && [dict get $statuses $pid2] eq $status2 136 && $status1 eq 0 137 && $status2 eq 0 138 } 139} -result {1} -cleanup { 140 tcl::process purge 141 tcl::process autopurge 1 142} 143# - 3-stage pipe 144test process-4.3 {exec 3-stage pipe} -body { 145 tcl::process autopurge 0 146 set pids [exec \ 147 [interpreter] $path(exit) 0 \ 148 | [interpreter] $path(exit) 0 \ 149 | [interpreter] $path(exit) 0 \ 150 &] 151 lassign $pids pid1 pid2 pid3 152 set list [tcl::process list] 153 set statuses [tcl::process status -wait] 154 set status1 [lindex [tcl::process status $pid1] 1] 155 set status2 [lindex [tcl::process status $pid2] 1] 156 set status3 [lindex [tcl::process status $pid3] 1] 157 expr { 158 [llength $pids] eq 3 159 && [llength $list] eq 3 160 && [lsearch $list $pid1] >= 0 161 && [lsearch $list $pid2] >= 0 162 && [lsearch $list $pid3] >= 0 163 && [dict size $statuses] eq 3 164 && [dict get $statuses $pid1] eq $status1 165 && [dict get $statuses $pid2] eq $status2 166 && [dict get $statuses $pid3] eq $status3 167 && $status1 eq 0 168 && $status2 eq 0 169 && $status3 eq 0 170 } 171} -result {1} -cleanup { 172 tcl::process purge 173 tcl::process autopurge 1 174} 175 176# Spawn subprocesses using [open "|"] 177# - One child 178test process-5.1 {exec one child} -body { 179 tcl::process autopurge 0 180 set f [open "|\"[interpreter]\" \"$path(exit)\" 0"] 181 set pid [pid $f] 182 set list [tcl::process list] 183 set statuses [tcl::process status -wait] 184 set status [lindex [tcl::process status $pid] 1] 185 expr { 186 [llength $list] eq 1 187 && [lindex $list 0] eq $pid 188 && [dict size $statuses] eq 1 189 && [dict get $statuses $pid] eq $status 190 && $status eq 0 191 } 192} -result {1} -cleanup { 193 close $f 194 tcl::process purge 195 tcl::process autopurge 1 196} 197# - Two children 198test process-5.2 {exec two children in parallel} -body { 199 tcl::process autopurge 0 200 set f1 [open "|\"[interpreter]\" \"$path(exit)\" 0"] 201 set f2 [open "|\"[interpreter]\" \"$path(exit)\" 0"] 202 set pid1 [pid $f1] 203 set pid2 [pid $f2] 204 set list [tcl::process list] 205 set statuses [tcl::process status -wait] 206 set status1 [lindex [tcl::process status $pid1] 1] 207 set status2 [lindex [tcl::process status $pid2] 1] 208 expr { 209 [llength $list] eq 2 210 && [lsearch $list $pid1] >= 0 211 && [lsearch $list $pid2] >= 0 212 && [dict size $statuses] eq 2 213 && [dict get $statuses $pid1] eq $status1 214 && [dict get $statuses $pid2] eq $status2 215 && $status1 eq 0 216 && $status2 eq 0 217 } 218} -result {1} -cleanup { 219 close $f1 220 close $f2 221 tcl::process purge 222 tcl::process autopurge 1 223} 224# - 3-stage pipe 225test process-5.3 {exec 3-stage pipe} -body { 226 tcl::process autopurge 0 227 set f [open "| 228 \"[interpreter]\" \"$path(exit)\" 0 229 | \"[interpreter]\" \"$path(exit)\" 0 230 | \"[interpreter]\" \"$path(exit)\" 0 231 "] 232 set pids [pid $f] 233 lassign $pids pid1 pid2 pid3 234 set list [tcl::process list] 235 set statuses [tcl::process status -wait] 236 set status1 [lindex [tcl::process status $pid1] 1] 237 set status2 [lindex [tcl::process status $pid2] 1] 238 set status3 [lindex [tcl::process status $pid3] 1] 239 expr { 240 [llength $pids] eq 3 241 && [llength $list] eq 3 242 && [lsearch $list $pid1] >= 0 243 && [lsearch $list $pid2] >= 0 244 && [lsearch $list $pid3] >= 0 245 && [dict size $statuses] eq 3 246 && [dict get $statuses $pid1] eq $status1 247 && [dict get $statuses $pid2] eq $status2 248 && [dict get $statuses $pid3] eq $status3 249 && $status1 eq 0 250 && $status2 eq 0 251 && $status3 eq 0 252 } 253} -result {1} -cleanup { 254 close $f 255 tcl::process purge 256 tcl::process autopurge 1 257} 258 259# Async child status 260test process-6.1 {async status} -setup { 261 signal_exit $path(test-signalfile) 0; # clean signal-file 262} -body { 263 tcl::process autopurge 0 264 set pid [exec [interpreter] $path(sleep) 1 $path(test-signalfile) &] 265 set status1 [lindex [tcl::process status $pid] 1] 266 signal_exit $path(test-signalfile); # signal exit (stop sleep) 267 set status2 [lindex [tcl::process status -wait $pid] 1] 268 expr { 269 $status1 eq {} 270 && $status2 eq 0 271 } 272} -result {1} -cleanup { 273 tcl::process purge 274 tcl::process autopurge 1 275} 276test process-6.2 {selective wait} -setup { 277 signal_exit $path(test-signalfile) 0; # clean signal-files 278 signal_exit $path(test-signalfile2) 0; 279} -body { 280 tcl::process autopurge 0 281 # Child 1 sleeps 1s 282 set pid1 [exec [interpreter] $path(sleep) 1 $path(test-signalfile) &] 283 # Child 2 sleeps 1s 284 set pid2 [exec [interpreter] $path(sleep) 2 $path(test-signalfile2) &] 285 # Initial status 286 set status1_1 [lindex [tcl::process status $pid1] 1] 287 set status1_2 [lindex [tcl::process status $pid2] 1] 288 # Wait until child 1 termination 289 signal_exit $path(test-signalfile); # signal exit for pid1 (stop sleep) 290 set status2_1 [lindex [tcl::process status -wait $pid1] 1] 291 set status2_2 [lindex [tcl::process status $pid2] 1] 292 # Wait until child 2 termination 293 signal_exit $path(test-signalfile2); # signal exit for pid2 (stop sleep) 294 set status3_2 [lindex [tcl::process status -wait $pid2] 1] 295 set status3_1 [lindex [tcl::process status $pid1] 1] 296 expr { 297 $status1_1 eq {} 298 && $status1_2 eq {} 299 && $status2_1 eq 0 300 && $status2_2 eq {} 301 && $status3_1 eq 0 302 && $status3_2 eq 0 303 } 304} -result {1} -cleanup { 305 tcl::process purge 306 tcl::process autopurge 1 307} 308 309# Error codes 310test process-7.1 {normal exit} -body { 311 tcl::process autopurge 0 312 set pid [exec [interpreter] $path(exit) 0 &] 313 lindex [tcl::process status -wait $pid] 1 314} -result {0} -cleanup { 315 tcl::process purge 316 tcl::process autopurge 1 317} 318test process-7.2 {abnormal exit} -body { 319 tcl::process autopurge 0 320 set pid [exec [interpreter] $path(exit) 1 &] 321 lindex [tcl::process status -wait $pid] 1 322} -match glob -result {1 {child process exited abnormally} {CHILDSTATUS * 1}} -cleanup { 323 tcl::process purge 324 tcl::process autopurge 1 325} 326test process-7.3 {child killed} -constraints {win} -body { 327 tcl::process autopurge 0 328 set pid [exec [interpreter] $path(exit) -1 &] 329 lindex [tcl::process status -wait $pid] 1 330} -match glob -result {1 {child killed: unknown signal} {CHILDKILLED * {unknown signal} {unknown signal}}} -cleanup { 331 tcl::process purge 332 tcl::process autopurge 1 333} 334 335removeFile $path(exit) 336removeFile $path(sleep) 337 338rename wait_for_file {} 339rename signal_exit {} 340::tcltest::cleanupTests 341return 342