Tcl Source Code

    i eval [list set argv [lrange $args 1 end]]
    i eval [list package ifneeded tcltest [package provide tcltest] \
	    [package ifneeded tcltest [package provide tcltest]]]
    i eval {proc exit args {}}

    # Need to capture output in msg

    set code [catch {i eval {source $argv0}} foo]
if $code {
#puts "$code: $foo\n$::errorInfo"
}
    i eval {close $tcltest::outputChannel}
    interp delete [namespace current]::i
    set f [open $of]
    set msg [read -nonewline $f]
    close $f
    set f [open $ef]
    set err [read -nonewline $f]
    close $f
    removeFile output
    removeFile error
    if {[string length $err]} {
	set code 1
	append msg \n$err
    }
    return $code

#    return [catch {uplevel 1 [linsert $args 0  exec [interpreter]]} msg]
}
test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} {
    set result [slave msg test.tcl]
    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
	    [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 0 0 1}

}
# Test non-writeable directories, non-readable directories with directory flags
set notReadableDir [file join [temporaryDirectory] notreadable]
set notWriteableDir [file join [temporaryDirectory] notwriteable]
makeDirectory notreadable
makeDirectory notwriteable
switch -- $::tcl_platform(platform) {
    "unix" {
	file attributes $notReadableDir -permissions 00333
	file attributes $notWriteableDir -permissions 00555
    }
    default {
	catch {file attributes $notWriteableDir -readonly 1}
	catch {testchmod 000 $notWriteableDir}
    }

	set ::tcltest::workingDirectory $old
	cd $current
    }
}

# clean up from directory testing

switch $::tcl_platform(platform) {
    "unix" {
	file attributes $notReadableDir -permissions 777
	file attributes $notWriteableDir -permissions 777
    }
    default {
	catch {testchmod 777 $notWriteableDir}
	catch {file attributes $notWriteableDir -readonly 0}
    }
}

file delete -force $notReadableDir $notWriteableDir
removeFile a.tcl
removeFile thisdirectoryisafile
removeDirectory normaldirectory

# -file, -notfile, [matchFiles], [skipFiles]
test tcltest-9.1 {-file d*.tcl} -constraints {unixOrPc} -setup {
    set old [testsDirectory]

	slave1 eval [list set argv {-debug 2}]
	slave1 alias puts puts
	interp create slave2
	slave2 alias puts puts
    } -cleanup {
	interp delete slave2
	interp delete slave1
	if {$oldoptions == "none"} {
	    unset ::env(TCLTEST_OPTIONS) 
	} else {
	    set ::env(TCLTEST_OPTIONS) $oldoptions
	}
    } -body {
	slave1 eval [package ifneeded tcltest [package provide tcltest]]
	slave1 eval tcltest::debug