NSString *idString;
    NSWindow *win = TkMacOSXDrawableWindow(winPtr->window);
    if (win) {
	idString = win.tabbingIdentifier;
	result = Tcl_NewStringObj(idString.UTF8String, [idString length]);
    }
    if (result == NULL) {
	NSLog(@"Failed to read tabbing identifier; try calling update idletasks before getting/setting the tabbing identifier of the window.");
	return TCL_OK;
    }
    Tcl_SetObjResult(interp, result);
    if (objc == 3) {
	return TCL_OK;
    } else if (objc == 4) {
	int len;

		resultString = appearanceStrings[APPEARANCE_DARKAQUA];
	    }
#endif // MAC_OS_X_VERSION_MAX_ALLOWED >= 101400
	}
	result = Tcl_NewStringObj(resultString, strlen(resultString));
    }
    if (result == NULL) {
	NSLog(@"Failed to read appearance name; try calling update idletasks before getting/setting the appearance of the window.");
	return TCL_OK;
    }
    if (objc == 4) {
	int index;
	if (Tcl_GetIndexFromObjStruct(interp, objv[3], appearanceStrings,
                sizeof(char *), "appearancename", 0, &index) != TCL_OK) {
            return TCL_ERROR;

	}
    } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
	if (Tcl_GetInt(NULL, name, &level) != TCL_OK) {
	    goto levelError;
	}
	level = curLevel - level;
    } else {
	/*
	 * (historical, TODO) If name does not contain a level (#0 or 1),
	 * TclGetFrame and Tcl_UpVar2 uses current level - 1
	 */
	level = curLevel - 1;
	result = 0;
	name = "1"; /* be more consistent with TclObjGetFrame (error at top - 1) */
    }

#
# Sideeffects
#	May add paths to the list of defaults.

proc ::tcl::tm::Defaults {} {
    global env tcl_platform

    regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor
    set exe [file normalize [info nameofexecutable]]

    # Note that we're using [::list], not [list] because [list] means
    # something other than [::list] in this namespace.
    roots [::list \
	    [file dirname [info library]] \
	    [file join [file dirname [file dirname $exe]] lib] \

# Results
#	No result.
#
# Sideeffects
#	Calls 'path add' to paths to the list of module search paths.

proc ::tcl::tm::roots {paths} {
    regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor
    foreach pa $paths {
	set p [file join $pa tcl$major]
	for {set n $minor} {$n >= 0} {incr n -1} {
	    set px [file join $p ${major}.${n}]
	    if {![interp issafe]} {set px [file normalize $px]}
	    path add $px
	}

    lappend l [file size $path(test1)]
} -cleanup {
    chan close $f
} -result {0 60 72}
test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} -setup {
    file delete $path(test1)
    set l ""
} -constraints {unixOrWin} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -buffersize 60 -eofchar {}
    lappend l [file size $path(test1)]
    for {set i 0} {$i < 12} {incr i} {
	chan puts $f hello
    }
    lappend l [file size $path(test1)]

    return $result
} -cleanup {
    chan close $s
    chan close $s2
    chan close $server
} -result {1 readable 234567890 timer}

test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
    set out [open $path(script) w]
    chan puts $out {
	chan puts "normal message from pipe"
	chan puts stderr "error message from pipe"
	exit 1
    }
    proc readit {pipe} {

test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
    # Only on unix will setting the execute bit on a regular file cause that
    # file to be executable.
    testchmod 0o775 $gorpfile
    file exe $gorpfile
} 1
test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body {
    # On windows, must be a .exe, .com, etc.
    set x {}
    set gorpexes {}
    foreach ext {exe com cmd bat} {
        lappend x [file exe nosuchfile.$ext]
        set gorpexe [makeFile foo gorp.$ext]
        lappend gorpexes $gorpexe
        lappend x [file exe $gorpexe] [file exe [string toupper $gorpexe]]

    file delete -force $filename
} -result {3155760000 3155760000}

# owned
test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
    file owned a b
} -result {wrong # args: should be "file owned name"}
test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -setup {
    set fn $gorpfile
    # prefer temp file to check owner (try to avoid bug [7de2d722bd]):
    if {
	[info exists ::env(TEMP)] && [file isdirectory $::env(TEMP)] &&
        [file dirname $fn] ne [file normalize $::env(TEMP)]
    } {
	set fn [file join $::env(TEMP)/test-owner-from-tcl.txt]
	set fn [makeFile "data" test-owner-from-tcl.txt $::env(TEMP)]
    }
    # be sure we have really owned this file before trying to check that
    # (avoid dependency on admin with UAC and the setting "System objects:
    # Default owner for objects created by members of the Administrators group"):
    catch {
	exec takeown /F [file nativename $fn]
    }
} -body {
    file owned $fn
} -cleanup {
    if {$fn ne $gorpfile} {
	removeFile $fn
    }
} -result 1
test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup {
    # Avoid problems with AFS
    set tmpfile [makeFile "data" touch.me /tmp]
} -body {
    file owned $tmpfile
} -cleanup {

# The tests for Tcl_ScanObjCmd are in scan.test

# Tcl_SourceObjCmd
# More tests of Tcl_SourceObjCmd are in source.test

test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} -constraints {
    unixOrWin
} -returnCodes error -body {
    source
} -match glob -result {wrong # args: should be "source*fileName"}
test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} -constraints {
    unixOrWin
} -returnCodes error -body {
    source a b
} -match glob -result {wrong # args: should be "source*fileName"}
test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body {
    set file [makeFile {
	set x 146
	error "error in sourced file"

    cleanup
} -constraints {notRoot} -returnCodes error -body {
    file mkdir td1
    file rename ~_totally_bogus_user td1
} -result {user "_totally_bogus_user" doesn't exist}
test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup {
    cleanup
} -constraints {notRoot unixOrWin} -returnCodes error -body {
    file mkdir td1
    file rename / td1
} -result {error renaming "/" to "td1": file already exists}
test fCmd-3.16 {FileCopyRename: break on first error} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    createfile tf1

    file mkdir td1
    set x [list [file exists tf1] [file exists tf2] [file exists td1]]
    file delete tf1 td1 tf2
    lappend x [file exists tf1] [file exists tf2] [file exists tf3]
} -cleanup {cleanup} -result {1 1 1 0 0 0}
test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup {
    cleanup
} -constraints {notRoot unixOrWin} -body {
    createfile tf1
    createfile tf2
    file mkdir td1
    catch {file delete tf1 td1 $root tf2}
    list [file exists tf1] [file exists tf2] [file exists td1]
} -cleanup {cleanup} -result {0 1 0}
test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body {

    set a3 [catch {file copy -force tds2 tdd2}]
    set a4 [catch {file copy -force tds3 tdd3}]
    set a5 [catch {file copy -force tds4 tdd4}]
    list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup {
    cleanup
} -constraints {notRoot unixOrWin testchmod} -body {
    file mkdir tds1
    file mkdir tds2
    file mkdir [file join tdd1 tds1 xxx]
    file mkdir [file join tdd2 tds2 xxx]
    testchmod 0o555 tds2
    set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]
    set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]

} -result {bad argument to "-types": abcde}

file rename $horribleglobname globTest
file delete -force $tildeglobname
set globname globTest
unset horribleglobname tildeglobname

test filename-12.1 {simple globbing} {unixOrWin} {
    glob {}
} {.}
test filename-12.1.1 {simple globbing} -constraints {unixOrWin} -body {
    glob -types f {}
} -returnCodes error -result {no files matched glob pattern ""}
test filename-12.1.2 {simple globbing} {unixOrWin} {
    glob -types d {}
} {.}
test filename-12.1.3 {simple globbing} {unix} {
    glob -types hidden {}
} {.}
test filename-12.1.4 {simple globbing} -constraints {win} -body {
    glob -types hidden {}
} -returnCodes error -result {no files matched glob pattern ""}
test filename-12.1.5 {simple globbing} -constraints {win} -body {
    glob -types hidden c:/
} -returnCodes error -result {no files matched glob pattern "c:/"}
test filename-12.1.6 {simple globbing} {win} {
    glob c:/
} {c:/}
test filename-12.3 {simple globbing} {
    glob -nocomplain \{a1,a2\}
} {}
set globPreResult globTest/
set x1 x1.c
set y1 y1.c
test filename-12.4 {simple globbing} {unixOrWin} {
    lsort [glob globTest/x1.c globTest/y1.c globTest/foo]
} "$globPreResult$x1 $globPreResult$y1"
test filename-12.5 {simple globbing} {
    glob globTest\\/x1.c
} "$globPreResult$x1"
test filename-12.6 {simple globbing} {
    glob globTest\\/\\x1.c

} "$globPreResult$x1"
test filename-13.9 {globbing with brace substitution} {
    lsort [glob globTest/\{x,y\}1.c]
} [list $globPreResult$x1 $globPreResult$y1]
test filename-13.10 {globbing with brace substitution} {
    lsort [glob globTest/\{x,,y\}1.c]
} [list $globPreResult$x1 $globPreResult$y1]
test filename-13.11 {globbing with brace substitution} {unixOrWin} {
    lsort [glob globTest/\{x,x\\,z,z\}1.c]
} [lsort {globTest/x1.c globTest/x,z1.c globTest/z1.c}]
test filename-13.13 {globbing with brace substitution} {
    lsort [glob globTest/{a,b,x,y}1.c]
} [list $globPreResult$x1 $globPreResult$y1]
test filename-13.14 {globbing with brace substitution} {unixOrWin} {
    lsort [glob {globTest/{x1,y2,weird name}.c}]
} {{globTest/weird name.c} globTest/x1.c}
test filename-13.16 {globbing with brace substitution} {unixOrWin} {
    lsort [glob globTest/{x1.c,a1/*}]
} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
test filename-13.18 {globbing with brace substitution} {unixOrWin} {
    lsort [glob globTest/{x1.c,{a},a1/*}]
} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
test filename-13.20 {globbing with brace substitution} {unixOrWin} {
    lsort [glob globTest/{a,x}1/*/{x,y}*]
} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
test filename-13.22 {globbing with brace substitution} -body {
    glob globTest/\{a,x\}1/*/\{
} -returnCodes error -result {unmatched open-brace in file name}

test filename-14.1 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob glo*/*.c]
} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.3 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/?1.c]
} {globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.5 {asterisks, question marks, and brackets} -setup {
    # The current directory could be anywhere; do this to stop spurious
    # matches
    file mkdir globTestContext
    file rename globTest [file join globTestContext globTest]
    set savepwd [pwd]
    cd globTestContext
} -constraints {unixOrWin} -body {
    lsort [glob */*/*/*.c]
} -cleanup {
    # Reset to where we were
    cd $savepwd
    file rename [file join globTestContext globTest] globTest
    file delete globTestContext
} -result {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
test filename-14.7 {asterisks, question marks, and brackets} {unix} {
    lsort [glob globTest/*]
} {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.7.1 {asterisks, question marks, and brackets} {win} {
    lsort [glob globTest/*]
} {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.9 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/.*]
} {globTest/. globTest/.. globTest/.1}
test filename-14.11 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/*/*]
} {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3}
test filename-14.13 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob {globTest/[xyab]1.*}]
} {globTest/x1.c globTest/y1.c}
test filename-14.15 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/*/]
} {globTest/a1/ globTest/a2/ globTest/a3/}
test filename-14.17 {asterisks, question marks, and brackets} -setup {
    global env
    set temp $env(HOME)
} -body {
    set env(HOME) [file join $env(HOME) globTest]
    glob ~/z*
} -cleanup {
    set env(HOME) $temp
} -result [list [file join $env(HOME) globTest z1.c]]
test filename-14.18 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/*.c goo/*]
} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.20 {asterisks, question marks, and brackets} {
    glob -nocomplain goo/*
} {}
test filename-14.21 {asterisks, question marks, and brackets} -body {
    glob globTest/*/gorp

	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-14.26 {type specific globbing} {
    glob -nocomplain -dir globTest -types {readonly} *
} {}
test filename-14.27 {Bug 2710920} {unixOrWin} {
    file tail [lindex [lsort [glob globTest/*/]] 0]
} a1
test filename-14.28 {Bug 2710920} {unixOrWin} {
    file dirname [lindex [lsort [glob globTest/*/]] 0]
} globTest
test filename-14.29 {Bug 2710920} {unixOrWin} {
    file extension [lindex [lsort [glob globTest/*/]] 0]
} {}
test filename-14.30 {Bug 2710920} {unixOrWin} {
    file rootname [lindex [lsort [glob globTest/*/]] 0]
} globTest/a1/

test filename-14.31 {Bug 2918610} -setup {
    set d [makeDirectory foo]
    makeFile {} bar.soom $d
} -body {

    lappend l [interp aliases a] [interp hidden a]
} -cleanup {
    interp delete a
} -result {{} bar {} bar bar {} {}}
test interp-23.2 {testing hiding vs aliases: safe interp} -setup {
    catch {interp delete a}
    set l ""
} -constraints {unixOrWin} -body {
    interp create a -safe
    lappend l [lsort [interp hidden a]]
    a alias bar bar
    lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
    a hide bar
    lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
    a alias bar {}

    lappend l [file size $path(test1)]
    flush $f
    lappend l [file size $path(test1)]
    close $f
    set l
} {0 60 72}
test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \
	{unixOrWin} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf -buffersize 60 -eofchar {}
    set l ""
    lappend l [file size $path(test1)]
    for {set i 0} {$i < 12} {incr i} {
	puts $f hello

    vwait [namespace which -variable result]
    close $s
    close $s2
    close $server
    set result
} {1 readable 234567890 timer}

test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
    set out [open $path(script) w]
    puts $out {
	puts "normal message from pipe"
	puts stderr "error message from pipe"
	exit 1
    }
    proc readit {pipe} {

    close $chan
    set res
} {1 {bad option "-buffer": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
removeFile fconfigure.dummy
test iocmd-8.14 {fconfigure command} {
    fconfigure stdin -buffers
} 4096
test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup {
    set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
    set port [lindex [fconfigure $srv -sockname] 2]
    proc iocmdSRV {sock ip port} {close $sock}
    set cli [socket 127.0.0.1 $port]
} -body {
    fconfigure $cli -blah
} -cleanup {

test iocmd-10.5 {fblocked command} {
    fblocked stdin
} 0

set path(test4) [makeFile {} test4]
set path(test5) [makeFile {} test5]

test iocmd-11.1 {I/O to command pipelines} {unixOrWin unixExecs} {
    set f [open $path(test4) w]
    close $f
    list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode
} {1 {can't write input to command: standard input was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.2 {I/O to command pipelines} {unixOrWin unixExecs} {
    list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode
} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.3 {I/O to command pipelines} {unixOrWin unixExecs} {
    list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.4 {I/O to command pipelines} {notValgrind unixOrWin} {
    list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode
} {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}}

test iocmd-12.1 {POSIX open access modes: RDONLY} {
    file delete $path(test1)
    set f [open $path(test1) w]
    puts $f "Two lines: this one"

}

testConstraint pidDefined [llength [info commands pid]]

test pid-1.1 {pid command} pidDefined {
    regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid]
} 1
test pid-1.2 {pid command} -constraints {unixOrWin unixExecs pidDefined} -setup {
    set path(test1) [makeFile {} test1]
    file delete $path(test1)
} -body {
    set f [open |[list echo foo | cat >$path(test1)] w]
    set pids [pid $f]
    close $f
    list [llength $pids] [regexp {^[0-9]+$} [lindex $pids 0]] \

    after cancel $timer
    close $s
    close $s1
} -result {1 3}
test socket_$af-7.5 {testing socket specific options} -setup {
    set timer [after 10000 "set x timed_out"]
    set l ""
} -constraints [list socket supported_$af unixOrWin] -body {
    set s [socket -server accept 0]
    proc accept {s a p} {
	global x
	set x [fconfigure $s -sockname]
	close $s
    }
    set listen [lindex [fconfigure $s -sockname] 2]

    removeFile error
    if {[string length $err]} {
	set code 1
	append msg \n$err
    }
    return $code
}
test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrWin} {
    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 tcltest-2.1 {tcltest -verbose 'b'} {unixOrWin} {
    set result [slave msg test.tcl -verbose 'b']
    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 tcltest-2.2 {tcltest -verbose 'p'} {unixOrWin} {
    set result [slave msg test.tcl -verbose 'p']
    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 0 1 0 1}
test tcltest-2.3 {tcltest -verbose 's'} {unixOrWin} {
    set result [slave msg test.tcl -verbose 's']
    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 0 0 1 1}
test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrWin} {
    set result [slave msg test.tcl -verbose 'ps']
    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 0 1 1 1}
test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrWin} {
    set result [slave msg test.tcl -verbose 'psb']
    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 1 1 1}

test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrWin} {
    set result [slave msg test.tcl -verbose "pass skip body"]
    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 1 1 1}

test tcltest-2.6 {tcltest -verbose 't'}  {
    -constraints {unixOrWin}
    -body {
	set result [slave msg test.tcl -verbose 't']
	list $result $msg
    }
    -result {^0 .*a-1.0 start.*b-1.0 start}
    -match regexp
}

test tcltest-2.6a {tcltest -verbose 'start'}  {
    -constraints {unixOrWin}
    -body {
	set result [slave msg test.tcl -verbose start]
	list $result $msg
    }
    -result {^0 .*a-1.0 start.*b-1.0 start}
    -match regexp
}

	verbose $oldVerbosity
	list $currentVerbosity $newVerbosity
    }
    -result {body {}}
}

test tcltest-2.8 {tcltest -verbose 'error'} {
    -constraints {unixOrWin}
    -body {
	set result [slave msg test.tcl -verbose error]
	list $result $msg
    }
    -result {errorInfo: foo.*errorCode: 9}
    -match regexp
}
# -match, [match]
test tcltest-3.1 {tcltest -match 'a*'} {unixOrWin} {
    set result [slave msg test.tcl -match a* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 1 0 0 1}
test tcltest-3.2 {tcltest -match 'b*'} {unixOrWin} {
    set result [slave msg test.tcl -match b* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 1 0 1}
test tcltest-3.3 {tcltest -match 'c*'} {unixOrWin} {
    set result [slave msg test.tcl -match c* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+0.+Skipped.+4.+Failed.+0" $msg]
} {0 0 0 1 1}
test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrWin} {
    set result [slave msg test.tcl -match {a* b*} -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
} {0 1 1 0 1}

test tcltest-3.5 {tcltest::match}  {
    -body {
	set oldMatch [match]
	match foo
	set currentMatch [match]
	match bar
	set newMatch [match]
	match $oldMatch
	list $currentMatch $newMatch
    }
    -result {foo bar}
}

# -skip, [skip]
test tcltest-4.1 {tcltest -skip 'a*'} {unixOrWin} {
    set result [slave msg test.tcl -skip a* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
} {0 0 1 1 1}
test tcltest-4.2 {tcltest -skip 'b*'} {unixOrWin} {
    set result [slave msg test.tcl -skip b* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
} {0 1 0 1 1}
test tcltest-4.3 {tcltest -skip 'c*'} {unixOrWin} {
    set result [slave msg test.tcl -skip c* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 0 1}
test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrWin} {
    set result [slave msg test.tcl -skip {a* b*} -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 0 1 1}
test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrWin} {
    set result [slave msg test.tcl -match {a* b*} -skip b* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 1 0 0 1}

test tcltest-4.6 {tcltest::skip} {
    -body {
	set oldSkip [skip]
	skip foo
	set currentSkip [skip]
	skip bar
	set newSkip [skip]
	skip $oldSkip
	list $currentSkip $newSkip
    }
    -result {foo bar}
}

# -constraints, -limitconstraints, [testConstraint],
# $constraintsSpecified, [limitConstraints]
test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrWin} {
    set result [slave msg test.tcl -constraints knownBug -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+2.+Skipped.+0.+Failed.+2" $msg]
} {0 1 1 1 1}
test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrWin} {
    set result [slave msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1]
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 0 0 1 1}

test tcltest-5.3 {testConstraint - constraint empty (tcltest::safeFetch)}  {
    -body {

    ::tcltest::PrintError "a really really long string containing a \
	    \"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\""
    ::tcltest::PrintError "Problem renaming file: error renaming \"Z:/ws/tcl8.2/win32-ix86/tests/core\" to \"Z:/ws/tcl8.2/win32-ix86/tests/movecore-core\""
    exit
} printerror.tcl]

test tcltest-6.1 {tcltest -outfile, -errfile defaults} {
    -constraints unixOrWin
    -body {
	slave msg $printerror
	return $msg
    }
    -result {a test.*a really}
    -match regexp
}
test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrWin unixExecs} {
    slave msg $printerror -outfile a.tmp
    set result1 [catch {exec grep "a test" a.tmp}]
    set result2 [catch {exec grep "a really" a.tmp}]
    list [regexp "a test" $msg] [regexp "a really" $msg] \
	    $result1 $result2 [file exists a.tmp] [file delete a.tmp]
} {0 1 0 1 1 {}}
test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrWin unixExecs} {
    slave msg $printerror -errfile a.tmp
    set result1 [catch {exec grep "a test" a.tmp}]
    set result2 [catch {exec grep "a really" a.tmp}]
    list [regexp "a test" $msg] [regexp "a really" $msg] \
	    $result1 $result2 [file exists a.tmp] [file delete a.tmp]
} {1 0 1 0 1 {}}
test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrWin unixExecs} {
    slave msg $printerror -outfile a.tmp -errfile b.tmp
    set result1 [catch {exec grep "a test" a.tmp}]
    set result2 [catch {exec grep "a really" b.tmp}]
    list [regexp "a test" $msg] [regexp "a really" $msg] \
	    $result1 $result2 \
	    [file exists a.tmp] [file delete a.tmp] \
	    [file exists b.tmp] [file delete b.tmp]

    }
}

# -debug, [debug]
# Must use child processes to test -debug because it always writes
# messages to stdout, and we have no way to capture stdout of a
# slave interp
test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrWin} {
    catch {exec [interpreter] test.tcl -debug 0} msg
    regexp "Flags passed into tcltest" $msg
} {0}
test tcltest-7.2 {tcltest test.tcl -debug 1} {unixOrWin} {
    catch {exec [interpreter] test.tcl -debug 1 -skip b*} msg
    list [regexp userSpecifiedSkip $msg] \
	    [regexp "Flags passed into tcltest" $msg]
} {1 0}
test tcltest-7.3 {tcltest test.tcl -debug 1} {unixOrWin} {
    catch {exec [interpreter] test.tcl -debug 1 -match b*} msg
    list [regexp userSpecifiedNonMatch $msg] \
	    [regexp "Flags passed into tcltest" $msg]
} {1 0}
test tcltest-7.4 {tcltest test.tcl -debug 2} {unixOrWin} {
    catch {exec [interpreter] test.tcl -debug 2} msg
    list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg]
} {1 0}
test tcltest-7.5 {tcltest test.tcl -debug 3} {unixOrWin} {
    catch {exec [interpreter] test.tcl -debug 3} msg
    list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg]
} {1 1}

test tcltest-7.6 {tcltest::debug} {
    -setup {
	set old $::tcltest::debug

set tdiaf [makeFile {} thisdirectoryisafile]

set normaldirectory [makeDirectory normaldirectory]
normalizePath normaldirectory

# -tmpdir, [temporaryDirectory]
test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrWin -setup {
    file delete -force thisdirectorydoesnotexist
} -body {
    slave msg $a -tmpdir thisdirectorydoesnotexist
    file exists [file join thisdirectorydoesnotexist a.tmp]
} -cleanup {
    file delete -force thisdirectorydoesnotexist
} -result 1
test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {
    -constraints unixOrWin
    -body {
	slave msg $a -tmpdir $tdiaf
	return $msg
    }
    -result {*not a directory*}
    -match glob
}

# interfere with tcltest-5.5
testConstraint notFAT [expr {
       ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWriteableDir] 1]]
    || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]]
}]
# FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used
test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
    -constraints {unixOrWin notRoot notFAT}
    -body {
	slave msg $a -tmpdir $notWriteableDir
	return $msg
    }
    -result {*not writeable*}
    -match glob
}
test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {
    -constraints unixOrWin
    -body {
	slave msg $a -tmpdir $normaldirectory
	# The join is necessary because the message can be split on multiple
	# lines
	file exists [file join $normaldirectory a.tmp]
    }
    -cleanup {

    list $f1 $f2 $f3
} -cleanup {
    set ::tcltest::temporaryDirectory $old
} -result [list $normaldirectory [workingDirectory] [workingDirectory]]
cd [temporaryDirectory]
# -testdir, [testsDirectory]
test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {
    -constraints unixOrWin
    -setup {
	file delete -force thisdirectorydoesnotexist
    }
    -body {
	slave msg $a -testdir thisdirectorydoesnotexist
	return $msg
    }
    -match glob
    -result {*does not exist*}
}
test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {
    -constraints unixOrWin
    -body {
	slave msg $a -testdir $tdiaf
	return $msg
    }
    -match glob
    -result {*not a directory*}
}
test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {
    -constraints {unix notRoot}
    -body {
	slave msg $a -testdir $notReadableDir
	return $msg
    }
    -match glob
    -result {*not readable*}
}
test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {
    -constraints unixOrWin
    -body {
	slave msg $a -testdir $normaldirectory
	# The join is necessary because the message can be split on multiple
	# lines
	list [string first "testdir: $normaldirectory" [join $msg]] \
	    [file exists [file join [temporaryDirectory] a.tmp]]
    }

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

# -file, -notfile, [matchFiles], [skipFiles]
test tcltest-9.1 {-file d*.tcl} -constraints {unixOrWin} -setup {
    set old [testsDirectory]
    testsDirectory [file dirname [info script]]
} -body {
    slave msg [file join [testsDirectory] all.tcl] -file d*.test
    return $msg
} -cleanup {
    testsDirectory $old
} -match regexp -result {dstring\.test}

test tcltest-9.2 {-file d*.tcl} -constraints {unixOrWin} -setup {
    set old [testsDirectory]
    testsDirectory [file dirname [info script]]
} -body {
    slave msg [file join [testsDirectory] all.tcl] \
	    -file d*.test -notfile dstring*
    regexp {dstring\.test} $msg
} -cleanup {

	close $f
    } {}
    ::tcltest::cleanupTests
    return
} makecore.tcl]

cd [temporaryDirectory]
test tcltest-10.1 {-preservecore 0} {unixOrWin} {
    slave msg $mc -preservecore 0
    file delete core
    regexp "Core file produced" $msg
} {0}
test tcltest-10.2 {-preservecore 1} {unixOrWin} {
    slave msg $mc -preservecore 1
    file delete core
    regexp "Core file produced" $msg
} {1}
test tcltest-10.3 {-preservecore 2} {unixOrWin} {
    slave msg $mc -preservecore 2
    file delete core
    list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
	    [regexp "core-" $msg] [file delete core-makecore]
} {1 1 1 {}}
test tcltest-10.4 {-preservecore 3} {unixOrWin} {
    slave msg $mc -preservecore 3
    file delete core
    list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
	    [regexp "core-" $msg] [file delete core-makecore]
} {1 1 1 {}}

# Removing this test.  It makes no sense to test the ability of

    package require tcltest
    namespace import tcltest::*
    puts [outputChannel] $::tcltest::loadScript
    exit
}
set loadfile [makeFile $contents load.tcl]

test tcltest-12.1 {-load xxx} {unixOrWin} {
    slave msg $loadfile -load xxx
    return $msg
} {xxx}

# Using child process because of -debug usage.
test tcltest-12.2 {-loadfile load.tcl} {unixOrWin} {
    catch {exec [interpreter] $loadfile -debug 2 -loadfile $loadfile} msg
    list \
	    [regexp {tcltest} [join [list $msg] [split $msg \n]]] \
	    [regexp {loadScript} [join [list $msg] [split $msg \n]]]
} {1 1}

test tcltest-12.3 {loadScript} {

    namespace import tcltest::*
    testsDirectory [file join [temporaryDirectory] singleprocdir]
    runAllTests
} all-single.tcl $spd]
cd [workingDirectory]

test tcltest-14.1 {-singleproc - single process} {
    -constraints {unixOrWin}
    -body {
	slave msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
	return $msg
    }
    -result {Test file error: can't unset .foo.: no such variable}
    -match regexp
}

test tcltest-14.2 {-singleproc - multiple process} {
    -constraints {unixOrWin}
    -body {
	slave msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]
	return $msg
    }
    -result {single1.test.*single2.test.*all\-single.tcl:.*Total.*0.*Passed.*0.*Skipped.*0.*Failed.*0}
    -match regexp
}

    package require tcltest
    namespace import -force tcltest::*
    testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.3]
    runAllTests
} all.tcl $dtd3

test tcltest-15.1 {basic directory walking} {
    -constraints {unixOrWin}
    -body {
	if {[slave msg \
		[file join $dtd all.tcl] \
		-tmpdir [temporaryDirectory]] == 1} {
	    error $msg
	}
    }
    -match regexp
    -returnCodes 1
    -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123]}
}

test tcltest-15.2 {-asidefromdir} {
    -constraints {unixOrWin}
    -body {
	if {[slave msg \
		[file join $dtd all.tcl] \
		-asidefromdir dirtestdir2.3 \
		-tmpdir [temporaryDirectory]] == 1} {
	    error $msg
	}
    }
    -match regexp
    -returnCodes 1
    -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.[12].*Tests located in:.*dirtestdir2.[12].*dirtestdir2.[12] test ended at .*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Error:  No test files remain after applying your match and skip patterns!
Error:  No test files remain after applying your match and skip patterns!
Error:  No test files remain after applying your match and skip patterns!$}
}

test tcltest-15.3 {-relateddir, non-existent dir} {
    -constraints {unixOrWin}
    -body {
	if {[slave msg \
		[file join $dtd all.tcl] \
		-relateddir [file join [temporaryDirectory] dirtestdir0] \
		-tmpdir [temporaryDirectory]] == 1} {
	    error $msg
	}
    }
    -returnCodes 1
    -match regexp
    -result {[^~]|dirtestdir[^2]}
}

test tcltest-15.4 {-relateddir, subdir} {
    -constraints {unixOrWin}
    -body {
	if {[slave msg \
		[file join $dtd all.tcl] \
		-relateddir dirtestdir2.1 -tmpdir [temporaryDirectory]] == 1} {
	    error $msg
	}
    }
    -returnCodes 1
    -match regexp
    -result {Tests located in:.*dirtestdir2.[^23]}
}
test tcltest-15.5 {-relateddir, -asidefromdir} {
    -constraints {unixOrWin}
    -body {
	if {[slave msg \
		[file join $dtd all.tcl] \
		-relateddir "dirtestdir2.1 dirtestdir2.2" \
		-asidefromdir dirtestdir2.2 \
		-tmpdir [temporaryDirectory]] == 1} {
	    error $msg

    } -result {^3$} -match regexp -output\
{tcltest::debug\s+= 2.*tcltest::debug\s+= 3}

# Begin testing of tcltest procs ...

cd [temporaryDirectory]
# PrintError
test tcltest-20.1 {PrintError} {unixOrWin} {
    set result [slave msg $printerror]
    list $result [regexp "Error:  a really short string" $msg] \
	    [regexp "     \"quotes\"" $msg] [regexp "    \"Path" $msg] \
	    [regexp "    \"Really" $msg] [regexp Problem $msg]
} {1 1 1 1 1 1}
cd [workingDirectory]
removeFile printerror.tcl

    }
    cleanupTests
} test.test $atd

# Must use a child process because stdout/stderr parsing can't be
# duplicated in slave interp.
test tcltest-22.1 {runAllTests} {
    -constraints {unixOrWin}
    -body {
	exec [interpreter] \
		[file join $atd all.tcl] \
		-verbose t -tmpdir [temporaryDirectory]
    }
    -match regexp
    -result "Test files exiting with errors:.*error.test.*exit.test"

    ::tcl::tm::path list
} -result {geode snarf foo}


proc genpaths {base} {
    # Normalizing picks up drive letters on windows [Bug 1053568]
    set base [file normalize $base]
    regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor
    set results {}
    set base [file join $base tcl$major]
    lappend results [file join $base site-tcl]
    for {set i 0} {$i <= $minor} {incr i} {
	lappend results [file join $base ${major}.$i]
    }
    return $results

tclWinInit.${OBJEXT}: tclWinInit.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclWinPipe.${OBJEXT}: tclWinPipe.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclWinReg.${OBJEXT}: tclWinReg.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclWinDde.${OBJEXT}: tclWinDde.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

testMain.${OBJEXT}: tclAppInit.c
	$(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME)

tclMain2.${OBJEXT}: tclMain.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME)

# TIP #59, embedding of configuration information into the binary library.
#
# Part of Tcl's configuration information are the paths where it was installed
# and where it will look for its libraries (which can be different). We derive
# this information from the variables which can be overridden by the user. As
# every path can be configured separately we do not remember one general
# prefix/exec_prefix but all the different paths individually.

tclPkgConfig.${OBJEXT}: tclPkgConfig.c
	$(CC)	-c $(CC_SWITCHES)			\
		-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR_NATIVE)\"" \
		-DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR_NATIVE)\"" \
		-DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR_NATIVE)\"" \
		-DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR_NATIVE)\"" \
		-DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR)\"" \
		\
		-DCFG_RUNTIME_LIBDIR="\"$(libdir_native)\"" \
		-DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \
		-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \
		-DCFG_RUNTIME_INCDIR="\"$(includedir_native)\"" \
		-DCFG_RUNTIME_DOCDIR="\"$(mandir_native)\"" \
		-DBUILD_tcl \
		@DEPARG@ $(CC_OBJNAME)

# The following objects are part of the stub library and should not be built
# as DLL objects but none of the symbols should be exported

tclStubLib.${OBJEXT}: tclStubLib.c

	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.6.1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.1.tm;
	@echo "Installing package tcltest 2.5.1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.1.tm;
	@echo "Installing package platform 1.0.14 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
	@echo "Installing encodings";
	@for i in $(ROOT_DIR)/library/encoding/*.enc ; do \
		$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \