# process.test --
#
# This file contains a collection of tests for the tcl::process ensemble.
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 2017 Frederic Bonnet
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
# Utilities
set path(sleep) [makeFile {
after [expr $argv*1000]
exit
} sleep]
set path(exit) [makeFile {
exit $argv
} exit]
# Basic syntax checking
test process-1.1 {tcl::process command basic syntax} -returnCodes error -body {
tcl::process
} -result {wrong # args: should be "tcl::process subcommand ?arg ...?"}
test process-1.2 {tcl::process subcommands} -returnCodes error -body {
tcl::process ?
} -match glob -result {unknown or ambiguous subcommand "?": must be autopurge, list, purge, or status}
# Autopurge flag
# - Default state
test process-2.1 {autopurge default} -body {
tcl::process autopurge
} -result {1}
# - Enabling autopurge
test process-2.2 {enable autopurge} -body {
tcl::process autopurge true
tcl::process autopurge
} -result {1}
# - Disabling autopurge
test process-2.3 {disable autopurge} -body {
tcl::process autopurge false
tcl::process autopurge
} -result {0} -cleanup {tcl::process autopurge true}
# Subprocess list & status
test process-3.1 {empty subprocess list} -body {
llength [tcl::process list]
} -result {0}
test process-3.2 {empty subprocess status} -body {
dict size [tcl::process status]
} -result {0}
# Spawn subprocesses using [exec]
# - One child
test process-4.1 {exec one child} -body {
tcl::process autopurge 0
set pid [exec [interpreter] $path(exit) 0 &]
set list [tcl::process list]
set statuses [tcl::process status -wait]
set status [lindex [tcl::process status $pid] 1]
expr {
[llength $list] eq 1
&& [lindex $list 0] eq $pid
&& [dict size $statuses] eq 1
&& [dict get $statuses $pid] eq $status
&& $status eq 0
}
} -result {1} -cleanup {
tcl::process purge
tcl::process autopurge 1
}
# - Two children
test process-4.2 {exec two children in parallel} -body {
tcl::process autopurge 0
set pid1 [exec [interpreter] $path(exit) 0 &]
set pid2 [exec [interpreter] $path(exit) 0 &]
set list [tcl::process list]
set statuses [tcl::process status -wait]
set status1 [lindex [tcl::process status $pid1] 1]
set status2 [lindex [tcl::process status $pid2] 1]
expr {
[llength $list] eq 2
&& [lsearch $list $pid1] >= 0
&& [lsearch $list $pid2] >= 0
&& [dict size $statuses] eq 2
&& [dict get $statuses $pid1] eq $status1
&& [dict get $statuses $pid2] eq $status2
&& $status1 eq 0
&& $status2 eq 0
}
} -result {1} -cleanup {
tcl::process purge
tcl::process autopurge 1
}
# - 3-stage pipe
test process-4.3 {exec 3-stage pipe} -body {
tcl::process autopurge 0
set pids [exec \
[interpreter] $path(exit) 0 \
| [interpreter] $path(exit) 0 \
| [interpreter] $path(exit) 0 \
&]
lassign $pids pid1 pid2 pid3
set list [tcl::process list]
set statuses [tcl::process status -wait]
set status1 [lindex [tcl::process status $pid1] 1]
set status2 [lindex [tcl::process status $pid2] 1]
set status3 [lindex [tcl::process status $pid3] 1]
expr {
[llength $pids] eq 3
&& [llength $list] eq 3
&& [lsearch $list $pid1] >= 0
&& [lsearch $list $pid2] >= 0
&& [lsearch $list $pid3] >= 0
&& [dict size $statuses] eq 3
&& [dict get $statuses $pid1] eq $status1
&& [dict get $statuses $pid2] eq $status2
&& [dict get $statuses $pid3] eq $status3
&& $status1 eq 0
&& $status2 eq 0
&& $status3 eq 0
}
} -result {1} -cleanup {
tcl::process purge
tcl::process autopurge 1
}
# Spawn subprocesses using [open "|"]
# - One child
test process-5.1 {exec one child} -body {
tcl::process autopurge 0
set f [open "|\"[interpreter]\" \"$path(exit)\" 0"]
set pid [pid $f]
set list [tcl::process list]
set statuses [tcl::process status -wait]
set status [lindex [tcl::process status $pid] 1]
expr {
[llength $list] eq 1
&& [lindex $list 0] eq $pid
&& [dict size $statuses] eq 1
&& [dict get $statuses $pid] eq $status
&& $status eq 0
}
} -result {1} -cleanup {
close $f
tcl::process purge
tcl::process autopurge 1
}
# - Two children
test process-5.2 {exec two children in parallel} -body {
tcl::process autopurge 0
set f1 [open "|\"[interpreter]\" \"$path(exit)\" 0"]
set f2 [open "|\"[interpreter]\" \"$path(exit)\" 0"]
set pid1 [pid $f1]
set pid2 [pid $f2]
set list [tcl::process list]
set statuses [tcl::process status -wait]
set status1 [lindex [tcl::process status $pid1] 1]
set status2 [lindex [tcl::process status $pid2] 1]
expr {
[llength $list] eq 2
&& [lsearch $list $pid1] >= 0
&& [lsearch $list $pid2] >= 0
&& [dict size $statuses] eq 2
&& [dict get $statuses $pid1] eq $status1
&& [dict get $statuses $pid2] eq $status2
&& $status1 eq 0
&& $status2 eq 0
}
} -result {1} -cleanup {
close $f1
close $f2
tcl::process purge
tcl::process autopurge 1
}
# - 3-stage pipe
test process-5.3 {exec 3-stage pipe} -body {
tcl::process autopurge 0
set f [open "|
\"[interpreter]\" \"$path(exit)\" 0
| \"[interpreter]\" \"$path(exit)\" 0
| \"[interpreter]\" \"$path(exit)\" 0
"]
set pids [pid $f]
lassign $pids pid1 pid2 pid3
set list [tcl::process list]
set statuses [tcl::process status -wait]
set status1 [lindex [tcl::process status $pid1] 1]
set status2 [lindex [tcl::process status $pid2] 1]
set status3 [lindex [tcl::process status $pid3] 1]
expr {
[llength $pids] eq 3
&& [llength $list] eq 3
&& [lsearch $list $pid1] >= 0
&& [lsearch $list $pid2] >= 0
&& [lsearch $list $pid3] >= 0
&& [dict size $statuses] eq 3
&& [dict get $statuses $pid1] eq $status1
&& [dict get $statuses $pid2] eq $status2
&& [dict get $statuses $pid3] eq $status3
&& $status1 eq 0
&& $status2 eq 0
&& $status3 eq 0
}
} -result {1} -cleanup {
close $f
tcl::process purge
tcl::process autopurge 1
}
# Async child status
test process-6.1 {async status} -body {
tcl::process autopurge 0
set pid [exec [interpreter] $path(sleep) 1 &]
set status1 [lindex [tcl::process status $pid] 1]
set status2 [lindex [tcl::process status -wait $pid] 1]
expr {
$status1 eq {}
&& $status2 eq 0
}
} -result {1} -cleanup {
tcl::process purge
tcl::process autopurge 1
}
test process-6.2 {selective wait} -body {
tcl::process autopurge 0
# Child 1 sleeps 1s
set pid1 [exec [interpreter] $path(sleep) 1 &]
# Child 2 sleeps 1s
set pid2 [exec [interpreter] $path(sleep) 2 &]
# Initial status
set status1_1 [lindex [tcl::process status $pid1] 1]
set status1_2 [lindex [tcl::process status $pid2] 1]
# Wait until child 1 termination
set status2_1 [lindex [tcl::process status -wait $pid1] 1]
set status2_2 [lindex [tcl::process status $pid2] 1]
# Wait until child 2 termination
set status3_2 [lindex [tcl::process status -wait $pid2] 1]
set status3_1 [lindex [tcl::process status $pid1] 1]
expr {
$status1_1 eq {}
&& $status1_2 eq {}
&& $status2_1 eq 0
&& $status2_2 eq {}
&& $status3_1 eq 0
&& $status3_2 eq 0
}
} -result {1} -cleanup {
tcl::process purge
tcl::process autopurge 1
}
# Error codes
test process-7.1 {normal exit} -body {
tcl::process autopurge 0
set pid [exec [interpreter] $path(exit) 0 &]
lindex [tcl::process status -wait $pid] 1
} -result {0} -cleanup {
tcl::process purge
tcl::process autopurge 1
}
test process-7.2 {abnormal exit} -body {
tcl::process autopurge 0
set pid [exec [interpreter] $path(exit) 1 &]
lindex [tcl::process status -wait $pid] 1
} -match glob -result {1 {child process exited abnormally} {CHILDSTATUS * 1}} -cleanup {
tcl::process purge
tcl::process autopurge 1
}
test process-7.3 {child killed} -body {
tcl::process autopurge 0
set pid [exec [interpreter] $path(exit) -1 &]
lindex [tcl::process status -wait $pid] 1
} -match glob -result {1 {child killed: unknown signal} {CHILDKILLED * {unknown signal} {unknown signal}}} -cleanup {
tcl::process purge
tcl::process autopurge 1
}
::tcltest::cleanupTests
return