Merge core-8-branch

2 files changed, 267 insertions, 16 deletions

diff --git a/tests/process.test b/tests/process.test
index fb3a5e2..07c6e6f 100644
--- a/tests/process.test
+++ b/tests/process.test
@@ -13,19 +13,272 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     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 command basic syntax} -returnCodes error -body {
+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}
 
-test process-2.1 {tcl::process autopurge get} {tcl::process autopurge} {1}
-test process-2.2 {tcl::process autopurge set true} {
+# 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
-} {1}
-test process-2.3 {tcl::process autopurge set false} {
+} -result {1}
+# - Disabling autopurge
+test process-2.3 {disable autopurge} -body {
     tcl::process autopurge false
     tcl::process autopurge
-} {0}
+} -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
diff --git a/tests/utf.test b/tests/utf.test
index 39818cc..9dd8017 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -41,7 +41,7 @@ test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring {
 test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring {
     expr {[format %c -1] eq [testbytestring "\xef\xbf\xbd"]}
 } 1
-test utf-1.7 {Tcl_UniCharToUtf: 4 byte sequences} -constraints {tip389 testbytestring} -body {
+test utf-1.7 {Tcl_UniCharToUtf: 4 byte sequences} -constraints testbytestring -body {
     expr {"\U014e4e" eq [testbytestring "\xf0\x94\xb9\x8e"]}
 } -result 1
 
@@ -228,15 +228,13 @@ bsCheck \U4e21	20001
 bsCheck \U004e21	20001
 bsCheck \U00004e21	20001
 bsCheck \U0000004e21	78
-if {[testConstraint tip389]} {
-    bsCheck \U00110000	69632
-    bsCheck \U01100000	69632
-    bsCheck \U11000000	69632
-    bsCheck \U0010FFFF	1114111
-    bsCheck \U010FFFF0	1114111
-    bsCheck \U10FFFF00	1114111
-    bsCheck \UFFFFFFFF	1048575
-}
+bsCheck \U00110000	69632
+bsCheck \U01100000	69632
+bsCheck \U11000000	69632
+bsCheck \U0010FFFF	1114111
+bsCheck \U010FFFF0	1114111
+bsCheck \U10FFFF00	1114111
+bsCheck \UFFFFFFFF	1048575
 
 test utf-11.1 {Tcl_UtfToUpper} {
     string toupper {}