wrap.tcl
上传用户:tsgydb
上传日期:2007-04-14
资源大小:10674k
文件大小:2k
源码类别:

MySQL数据库

开发平台:

Visual C++

  1. # Sentinel file wrapper for multi-process tests.
  2. # This is designed to avoid a set of nasty bugs, primarily on Windows,
  3. # where pid reuse causes watch_procs to sit around waiting for some
  4. # random process that's not DB's and is not exiting.
  5. source ./include.tcl
  6. # Arguments:
  7. #
  8. if { $argc < 3 } {
  9. puts "FAIL: wrap.tcl: Usage: wrap.tcl script log scriptargs"
  10. exit
  11. }
  12. set script [lindex $argv 0]
  13. set logfile [lindex $argv 1]
  14. set args [lrange $argv 2 end]
  15. # Create a sentinel file to mark our creation and signal that watch_procs
  16. # should look for us.
  17. set parentpid [pid]
  18. set parentsentinel $testdir/begin.$parentpid
  19. set f [open $parentsentinel w]
  20. close $f
  21. # Create a Tcl subprocess that will actually run the test.
  22. set t [open "|$tclsh_path >& $logfile" w]
  23. # Create a sentinel for the subprocess.
  24. set childpid [pid $t]
  25. puts "Script watcher process $parentpid launching $script process $childpid."
  26. set childsentinel $testdir/begin.$childpid
  27. set f [open $childsentinel w]
  28. close $f
  29. # Set up argv for the subprocess, since the args aren't passed in as true
  30. # arguments thanks to the pipe structure.
  31. puts $t "set argc [llength $args]"
  32. puts $t "set argv [list $args]"
  33. # Command the test to run.
  34. puts $t "source $test_path/$script"
  35. # Close the pipe.  This will flush the above commands and actually run the
  36. # test, and will also return an error a la exec if anything bad happens
  37. # to the subprocess.  The magic here is that closing a pipe blocks
  38. # and waits for the exit of processes in the pipeline, at least according
  39. # to Ousterhout (p. 115).
  40. set ret [catch {close $t} res]
  41. # Write ending sentinel files--we're done.
  42. set f [open $testdir/end.$childpid w]
  43. close $f
  44. set f [open $testdir/end.$parentpid w]
  45. close $f
  46. exit $ret