Index: third_party/sqlite/src/test/lock_common.tcl |
diff --git a/third_party/sqlite/src/test/lock_common.tcl b/third_party/sqlite/src/test/lock_common.tcl |
index bc1eb86bdc2b8e4757431a51fe4b3b19fab1687f..a758e7af2e4d506301378ce86bcca155551483b1 100644 |
--- a/third_party/sqlite/src/test/lock_common.tcl |
+++ b/third_party/sqlite/src/test/lock_common.tcl |
@@ -86,21 +86,51 @@ proc launch_testfixture {{prg ""}} { |
# Execute a command in a child testfixture process, connected by two-way |
# channel $chan. Return the result of the command, or an error message. |
# |
-proc testfixture {chan cmd} { |
- puts $chan $cmd |
- puts $chan OVER |
- set r "" |
- while { 1 } { |
- set line [gets $chan] |
- if { $line == "OVER" } { |
- set res [lindex $r 1] |
- if { [lindex $r 0] } { error $res } |
- return $res |
- } |
- if {[eof $chan]} { |
- return "ERROR: Child process hung up" |
+proc testfixture {chan cmd args} { |
+ |
+ if {[llength $args] == 0} { |
+ fconfigure $chan -blocking 1 |
+ puts $chan $cmd |
+ puts $chan OVER |
+ |
+ set r "" |
+ while { 1 } { |
+ set line [gets $chan] |
+ if { $line == "OVER" } { |
+ set res [lindex $r 1] |
+ if { [lindex $r 0] } { error $res } |
+ return $res |
+ } |
+ if {[eof $chan]} { |
+ return "ERROR: Child process hung up" |
+ } |
+ append r $line |
} |
- append r $line |
+ return $r |
+ } else { |
+ set ::tfnb($chan) "" |
+ fconfigure $chan -blocking 0 -buffering none |
+ puts $chan $cmd |
+ puts $chan OVER |
+ fileevent $chan readable [list testfixture_script_cb $chan [lindex $args 0]] |
+ return "" |
+ } |
+} |
+ |
+proc testfixture_script_cb {chan script} { |
+ if {[eof $chan]} { |
+ append ::tfnb($chan) "ERROR: Child process hung up" |
+ set line "OVER" |
+ } else { |
+ set line [gets $chan] |
+ } |
+ |
+ if { $line == "OVER" } { |
+ uplevel #0 $script [list [lindex $::tfnb($chan) 1]] |
+ unset ::tfnb($chan) |
+ fileevent $chan readable "" |
+ } else { |
+ append ::tfnb($chan) $line |
} |
} |