1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 2000-2009 Oracle. All rights reserved. 4# 5# $Id$ 6# 7# Sentinel file wrapper for multi-process tests. This is designed to avoid a 8# set of nasty bugs, primarily on Windows, where pid reuse causes watch_procs 9# to sit around waiting for some random process that's not DB's and is not 10# exiting. 11 12source ./include.tcl 13source $test_path/testutils.tcl 14 15# Arguments: 16if { $argc < 2 } { 17 puts "FAIL: wrap.tcl: Usage: wrap.tcl script log [scriptargs]" 18 exit 19} 20 21set script [lindex $argv 0] 22set logfile [lindex $argv 1] 23if { $argc >= 2 } { 24 set skip [lindex $argv 2] 25 set args [lrange $argv 3 end] 26} else { 27 set skip "" 28 set args "" 29} 30# 31# Account in args for SKIP command, or not. 32# 33if { $skip != "SKIP" && $argc >= 2 } { 34 set args [lrange $argv 2 end] 35} 36 37# Create a sentinel file to mark our creation and signal that watch_procs 38# should look for us. 39set parentpid [pid] 40set parentsentinel $testdir/begin.$parentpid 41set f [open $parentsentinel w] 42close $f 43 44# Create a Tcl subprocess that will actually run the test. 45set t [open "|$tclsh_path >& $logfile" w] 46 47# Create a sentinel for the subprocess. 48set childpid [pid $t] 49puts "Script watcher process $parentpid launching $script process $childpid." 50set childsentinel $testdir/begin.$childpid 51set f [open $childsentinel w] 52close $f 53 54# 55# For the upgrade tests where a current release tclsh is starting up 56# a tclsh in an older release, we cannot tell it to source the current 57# test.tcl because new things may not exist in the old release. So, 58# we need to skip that and the script we're running in the old 59# release will have to take care of itself. 60# 61if { $skip != "SKIP" } { 62 puts $t "source $test_path/test.tcl" 63} 64puts $t "set script $script" 65 66# Set up argv for the subprocess, since the args aren't passed in as true 67# arguments thanks to the pipe structure. 68puts $t "set argc [llength $args]" 69puts $t "set argv [list $args]" 70 71set has_path [file dirname $script] 72if { $has_path != "." } { 73 set scr $script 74} else { 75 set scr $test_path/$script 76} 77#puts "Script $script: path $has_path, scr $scr" 78puts $t "set scr $scr" 79puts $t {set ret [catch { source $scr } result]} 80puts $t {if { [string length $result] > 0 } { puts $result }} 81puts $t {error_check_good "$scr run: $result: pid [pid]" $ret 0} 82 83# Close the pipe. This will flush the above commands and actually run the 84# test, and will also return an error a la exec if anything bad happens 85# to the subprocess. The magic here is that closing a pipe blocks 86# and waits for the exit of processes in the pipeline, at least according 87# to Ousterhout (p. 115). 88 89set ret [catch {close $t} res] 90 91# Write ending sentinel files--we're done. 92set f [open $testdir/end.$childpid w] 93close $f 94set f [open $testdir/end.$parentpid w] 95close $f 96 97error_check_good "Pipe close ($childpid: $script $argv: logfile $logfile)"\ 98 $ret 0 99exit $ret 100