For tcltest, selected modernizations and style improvements from Patrick Fradin.

1 files changed, 100 insertions, 108 deletions

diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 83ec9d3..1fd6f47 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -84,7 +84,7 @@ namespace eval tcltest {
     #     None.
     #
     proc normalizePath {pathVar} {
-	upvar $pathVar path
+	upvar 1 $pathVar path
 	set oldpwd [pwd]
 	catch {cd $path}
 	set path [pwd]
@@ -247,15 +247,15 @@ namespace eval tcltest {
 
     # Kept only for compatibility
     Default constraintsSpecified {} AcceptList
-    trace variable constraintsSpecified r {set ::tcltest::constraintsSpecified \
-		[array names ::tcltest::testConstraints] ;# }
+    trace add variable constraintsSpecified read [namespace code {
+	    set constraintsSpecified [array names testConstraints] ;#}]
 
     # tests that use threads need to know which is the main thread
     Default mainThread 1
     variable mainThread
-    if {[info commands thread::id] != {}} {
+    if {[info commands thread::id] ne {}} {
 	set mainThread [thread::id]
-    } elseif {[info commands testthread] != {}} {
+    } elseif {[info commands testthread] ne {}} {
 	set mainThread [testthread id]
     }
 
@@ -263,7 +263,7 @@ namespace eval tcltest {
     # Tcl tests is the working directory.  Whenever this value changes
     # change to that directory.
     variable workingDirectory
-    trace variable workingDirectory w \
+    trace add variable workingDirectory write \
 	    [namespace code {cd $workingDirectory ;#}]
 
     Default workingDirectory [pwd] AcceptAbsolutePath
@@ -277,7 +277,7 @@ namespace eval tcltest {
 
     # Set the location of the execuatble
     Default tcltest [info nameofexecutable]
-    trace variable tcltest w [namespace code {testConstraint stdio \
+    trace add variable tcltest write [namespace code {testConstraint stdio \
 	    [eval [ConstraintInitializer stdio]] ;#}]
 
     # save the platform information so it can be restored later
@@ -404,11 +404,11 @@ namespace eval tcltest {
 		# already there.
 		set outdir [normalizePath [file dirname \
 			[file join [pwd] $filename]]]
-		if {[string equal $outdir [temporaryDirectory]]} {
+		if {$outdir eq [temporaryDirectory]} {
 		    variable filesExisted
 		    FillFilesExisted
 		    set filename [file tail $filename]
-		    if {[lsearch -exact $filesExisted $filename] == -1} {
+		    if {$filename ni $filesExisted} {
 			lappend filesExisted $filename
 		    }
 		}
@@ -448,11 +448,11 @@ namespace eval tcltest {
 		# already there.
 		set outdir [normalizePath [file dirname \
 			[file join [pwd] $filename]]]
-		if {[string equal $outdir [temporaryDirectory]]} {
+		if {$outdir eq [temporaryDirectory]} {
 		    variable filesExisted
 		    FillFilesExisted
 		    set filename [file tail $filename]
-		    if {[lsearch -exact $filesExisted $filename] == -1} {
+		    if {$filename ni $filesExisted} {
 			lappend filesExisted $filename
 		    }
 		}
@@ -534,7 +534,7 @@ namespace eval tcltest {
 	    }
 	    default {
 		# Exact match trumps ambiguity
-		if {[lsearch -exact $match $option] >= 0} {
+		if {$option in $match} {
 		    return $option
 		}
 		set values [join [lrange $match 0 end-1] ", "]
@@ -549,7 +549,8 @@ namespace eval tcltest {
 	variable OptionControlledVariables
 	foreach varName [concat $OptionControlledVariables Option] {
 	    variable $varName
-	    trace variable $varName r [namespace code {ProcessCmdLineArgs ;#}]
+	    trace add variable $varName read [namespace code {
+		    ProcessCmdLineArgs ;#}]
 	}
     }
 
@@ -557,11 +558,11 @@ namespace eval tcltest {
 	variable OptionControlledVariables
 	foreach varName [concat $OptionControlledVariables Option] {
 	    variable $varName
-	    foreach pair [trace vinfo $varName] {
-		foreach {op cmd} $pair break
-		if {[string equal r $op]
-			&& [string match *ProcessCmdLineArgs* $cmd]} {
-		    trace vdelete $varName $op $cmd
+	    foreach pair [trace info variable $varName] {
+		lassign $pair op cmd
+		if {($op eq "read") &&
+			[string match *ProcessCmdLineArgs* $cmd]} {
+		    trace remove variable $varName $op $cmd
 		}
 	    }
 	}
@@ -698,7 +699,7 @@ namespace eval tcltest {
     Option -constraints {} {
 	Do not skip the listed constraints listed in -constraints.
     } AcceptList
-    trace variable Option(-constraints) w \
+    trace add variable Option(-constraints) write \
 	    [namespace code {SetSelectedConstraints ;#}]
 
     # Don't run only the "-constraint" specified tests by default
@@ -707,7 +708,7 @@ namespace eval tcltest {
 	variable testConstraints
 	if {!$Option(-limitconstraints)} {return}
 	foreach c [array names testConstraints] {
-	    if {[lsearch -exact $Option(-constraints) $c] == -1} {
+	    if {$c ni $Option(-constraints)} {
 		testConstraint $c 0
 	    }
 	}
@@ -715,7 +716,7 @@ namespace eval tcltest {
     Option -limitconstraints 0 {
 	whether to run only tests with the constraints
     } AcceptBoolean limitConstraints 
-    trace variable Option(-limitconstraints) w \
+    trace add variable Option(-limitconstraints) write \
 	    [namespace code {ClearUnselectedConstraints ;#}]
 
     # A test application has to know how to load the tested commands
@@ -736,7 +737,7 @@ namespace eval tcltest {
 	}
 	set directory [AcceptDirectory $directory]
 	if {![file writable $directory]} {
-	    if {[string equal [workingDirectory] $directory]} {
+	    if {[workingDirectory] eq $directory} {
 		# Special exception: accept the default value
 		# even if the directory is not writable
 		return $directory
@@ -750,7 +751,7 @@ namespace eval tcltest {
     Option -tmpdir [workingDirectory] {
 	Save temporary files in the specified directory.
     } AcceptTemporaryDirectory temporaryDirectory
-    trace variable Option(-tmpdir) w \
+    trace add variable Option(-tmpdir) write \
 	    [namespace code {normalizePath Option(-tmpdir) ;#}]
 
     # Tests should not rely on the current working directory.
@@ -759,17 +760,17 @@ namespace eval tcltest {
     Option -testdir [workingDirectory] {
 	Search tests in the specified directory.
     } AcceptDirectory testsDirectory
-    trace variable Option(-testdir) w \
+    trace add variable Option(-testdir) write \
 	    [namespace code {normalizePath Option(-testdir) ;#}]
 
     proc AcceptLoadFile { file } {
-	if {[string equal "" $file]} {return $file}
+	if {$file eq {}} {return $file}
 	set file [file join [temporaryDirectory] $file]
 	return [AcceptReadable $file]
     }
     proc ReadLoadScript {args} {
 	variable Option
-	if {[string equal "" $Option(-loadfile)]} {return}
+	if {$Option(-loadfile) eq {}} {return}
 	set tmp [open $Option(-loadfile) r]
 	loadScript [read $tmp]
 	close $tmp
@@ -777,7 +778,7 @@ namespace eval tcltest {
     Option -loadfile {} {
 	Read the script to load the tested commands from the specified file.
     } AcceptLoadFile loadFile
-    trace variable Option(-loadfile) w [namespace code ReadLoadScript]
+    trace add variable Option(-loadfile) write [namespace code ReadLoadScript]
 
     proc AcceptOutFile { file } {
 	if {[string equal stderr $file]} {return $file}
@@ -789,14 +790,14 @@ namespace eval tcltest {
     Option -outfile stdout {
 	Send output from test runs to the specified file.
     } AcceptOutFile outputFile
-    trace variable Option(-outfile) w \
+    trace add variable Option(-outfile) write \
 	    [namespace code {outputChannel $Option(-outfile) ;#}]
 
     # errors go to stderr by default
     Option -errfile stderr {
 	Send errors from test runs to the specified file.
     } AcceptOutFile errorFile
-    trace variable Option(-errfile) w \
+    trace add variable Option(-errfile) write \
 	    [namespace code {errorChannel $Option(-errfile) ;#}]
 
     proc loadIntoSlaveInterpreter {slave args} {
@@ -877,7 +878,7 @@ proc tcltest::DebugPArray {level arrayvar} {
     variable debug
 
     if {$debug >= $level} {
-	catch {upvar  $arrayvar $arrayvar}
+	catch {upvar 1 $arrayvar $arrayvar}
 	parray $arrayvar
     }
     return
@@ -961,8 +962,7 @@ proc tcltest::testConstraint {constraint {value ""}} {
     if {[catch {expr {$value && $value}} msg]} {
 	return -code error $msg
     }
-    if {[limitConstraints] 
-	    && [lsearch -exact $Option(-constraints) $constraint] == -1} {
+    if {[limitConstraints] && ($constraint ni $Option(-constraints))} {
 	set value 0
     }
     set testConstraints($constraint) $value
@@ -986,11 +986,13 @@ proc tcltest::interpreter { {interp ""} } {
     if {[llength [info level 0]] == 1} {
 	return $tcltest
     }
-    if {[string equal {} $interp]} {
-	set tcltest {}
-    } else {
-	set tcltest $interp
-    }
+
+if {$interp eq {}} {
+set tcltest {}
+} else {
+set tcltest $interp
+}
+#    set tcltest $interp
 }
 
 #####################################################################
@@ -1055,7 +1057,7 @@ proc tcltest::PrintError {errorMsg} {
 		[expr {80 - $InitialMsgLen}]]]
 	puts [errorChannel] [string range $errorMsg 0 $beginningIndex]
 
-	while {![string equal end $beginningIndex]} {
+	while {$beginningIndex ne "end"} {
 	    puts -nonewline [errorChannel] \
 		    [string repeat " " $InitialMsgLen]
 	    if {($endingIndex - $beginningIndex)
@@ -1108,7 +1110,7 @@ proc tcltest::PrintError {errorMsg} {
 proc tcltest::SafeFetch {n1 n2 op} {
     variable testConstraints
     DebugPuts 3 "entering SafeFetch $n1 $n2 $op"
-    if {[string equal {} $n2]} {return}
+    if {$n2 eq {}} {return}
     if {![info exists testConstraints($n2)]} {
 	if {[catch {testConstraint $n2 [eval [ConstraintInitializer $n2]]}]} {
 	    testConstraint $n2 0
@@ -1253,9 +1255,8 @@ proc tcltest::DefineConstraintInitializers {} {
     # are running as root on Unix.
 
     ConstraintInitializer root {expr \
-	    {[string equal unix $::tcl_platform(platform)]
-	    && ([string equal root $::tcl_platform(user)]
-		|| [string equal "" $::tcl_platform(user)])}}
+	    {($::tcl_platform(platform) eq "unix") &&
+		    ($::tcl_platform(user) in {root {}})}}
     ConstraintInitializer notRoot {expr {![testConstraint root]}}
 
     # Set nonBlockFiles constraint: 1 means this platform supports
@@ -1263,7 +1264,7 @@ proc tcltest::DefineConstraintInitializers {} {
 
     ConstraintInitializer nonBlockFiles {
 	    set code [expr {[catch {set f [open defs r]}] 
-		    || [catch {fconfigure $f -blocking off}]}]
+		    || [catch {chan configure $f -blocking off}]}]
 	    catch {close $f}
 	    set code
     }
@@ -1289,10 +1290,10 @@ proc tcltest::DefineConstraintInitializers {} {
 
     ConstraintInitializer unixExecs {
 	set code 1
-        if {[string equal macintosh $::tcl_platform(platform)]} {
+        if {$::tcl_platform(platform) eq "macintosh"} {
 	    set code 0
         }
-        if {[string equal windows $::tcl_platform(platform)]} {
+        if {$::tcl_platform(platform) eq "windows"} {
 	    if {[catch {
 	        set file _tcl_test_remove_me.txt
 	        makeFile {hello} $file
@@ -1386,7 +1387,7 @@ proc tcltest::Usage { {option ""} } {
 	set allOpts [concat -help [Configure]]
 	foreach opt $allOpts {
 	    set foo [Usage $opt]
-	    foreach [list x type($opt) usage($opt)] $foo break
+	    lassign $foo x type($opt) usage($opt)
 	    set line($opt) "  $opt $type($opt)  "
 	    set length($opt) [string length $line($opt)]
 	    if {$length($opt) > $max} {set max $length($opt)}
@@ -1410,7 +1411,7 @@ proc tcltest::Usage { {option ""} } {
 	    append msg $u
 	}
 	return $msg\n
-    } elseif {[string equal -help $option]} {
+    } elseif {$option eq "-help"} {
 	return [list -help "" "Display this usage information."]
     } else {
 	set type [lindex [info args $Verify($option)] 0]
@@ -1436,7 +1437,7 @@ proc tcltest::Usage { {option ""} } {
 
 proc tcltest::ProcessFlags {flagArray} {
     # Process -help first
-    if {[lsearch -exact $flagArray {-help}] != -1} {
+    if {"-help" in $flagArray} {
 	PrintUsageInfo
 	exit 1
     }
@@ -1445,14 +1446,14 @@ proc tcltest::ProcessFlags {flagArray} {
 	RemoveAutoConfigureTraces
     } else {
 	set args $flagArray
-	while {[llength $args]>1 && [catch {configure {*}$args} msg]} {
+	while {[llength $args] > 1 && [catch {configure {*}$args} msg]} {
 
 	    # Something went wrong parsing $args for tcltest options
 	    # Check whether the problem is "unknown option"
 	    if {[regexp {^unknown option (\S+):} $msg -> option]} {
 		# Could be this is an option the Hook knows about
 		set moreOptions [processCmdLineArgsAddFlagsHook]
-		if {[lsearch -exact $moreOptions $option] == -1} {
+		if {$option ni $moreOptions} {
 		    # Nope.  Report the error, including additional options,
 		    # but keep going
 		    if {[llength $moreOptions]} {
@@ -1471,7 +1472,7 @@ proc tcltest::ProcessFlags {flagArray} {
 
 	    # To recover, find that unknown option and remove up to it.
 	    # then retry
-	    while {![string equal [lindex $args 0] $option]} {
+	    while {[lindex $args 0] ne $option} {
 		set args [lrange $args 2 end]
 	    }
 	    set args [lrange $args 2 end]
@@ -1577,7 +1578,7 @@ proc tcltest::Replace::puts {args} {
 	}
 	2 {
 	    # Either -nonewline or channelId has been specified
-	    if {[string equal -nonewline [lindex $args 0]]} {
+	    if {[lindex $args 0] eq "-nonewline"} {
 		append outData [lindex $args end]
 		return
 		# return [Puts -nonewline [lindex $args end]]
@@ -1587,7 +1588,7 @@ proc tcltest::Replace::puts {args} {
 	    }
 	}
 	3 {
-	    if {[string equal -nonewline [lindex $args 0]]} {
+	    if {[lindex $args 0] eq "-nonewline"} {
 		# Both -nonewline and channelId are specified, unless
 		# it's an error.  -nonewline is supposed to be argv[0].
 		set channel [lindex $args 1]
@@ -1597,12 +1598,10 @@ proc tcltest::Replace::puts {args} {
     }
 
     if {[info exists channel]} {
-	if {[string equal $channel [[namespace parent]::outputChannel]]
-		|| [string equal $channel stdout]} {
+	if {$channel in [list [[namespace parent]::outputChannel] stdout]} {
 	    append outData [lindex $args end]$newline
 	    return
-	} elseif {[string equal $channel [[namespace parent]::errorChannel]]
-		|| [string equal $channel stderr]} {
+	} elseif {$channel in [list [[namespace parent]::errorChannel] stderr]} {
 	    append errData [lindex $args end]$newline
 	    return
 	}
@@ -1771,7 +1770,7 @@ proc tcltest::SubstArguments {argList} {
             set argList {}
         }
 
-        if {$token != {}} {
+        if {$token ne {}} {
             # If we saw a word with quote before, then there is a
             # multi-word token starting with that word.  In this case,
             # add the text and the current word to this token.
@@ -1878,10 +1877,7 @@ proc tcltest::test {name description args} {
     # Pre-define everything to null except output and errorOutput.  We
     # determine whether or not to trap output based on whether or not
     # these variables (output & errorOutput) are defined.
-    foreach item {constraints setup cleanup body result returnCodes
-	    match} {
-	set $item {}
-    }
+    lassign {} constraints setup cleanup body result returnCodes match
 
     # Set the default match mode
     set match exact
@@ -1893,8 +1889,7 @@ proc tcltest::test {name description args} {
 
     # The old test format can't have a 3rd argument (constraints or
     # script) that starts with '-'.
-    if {[string match -* [lindex $args 0]]
-	    || ([llength $args] <= 1)} {
+    if {[string match -* [lindex $args 0]] || ([llength $args] <= 1)} {
 	if {[llength $args] == 1} {
 	    set list [SubstArguments [lindex $args 0]]
 	    foreach {element value} $list {
@@ -1915,7 +1910,7 @@ proc tcltest::test {name description args} {
 		-match -output -errorOutput -constraints}
 
 	foreach flag [array names testAttributes] {
-	    if {[lsearch -exact $validFlags $flag] == -1} {
+	    if {$flag ni $validFlags} {
 		incr testLevel -1
 		set sorted [lsort $validFlags]
 		set options [join [lrange $sorted 0 end-1] ", "]
@@ -1931,7 +1926,7 @@ proc tcltest::test {name description args} {
 
 	# Check the values supplied for -match
 	variable CustomMatch
-	if {[lsearch [array names CustomMatch] $match] == -1} {
+	if {$match ni [array names CustomMatch]} {
 	    incr testLevel -1
 	    set sorted [lsort [array names CustomMatch]]
 	    set values [join [lrange $sorted 0 end-1] ", "]
@@ -1995,7 +1990,7 @@ proc tcltest::test {name description args} {
 	} else {
 	    set testResult [uplevel 1 [list [namespace origin Eval] $command 1]]
 	}
-	foreach {actualAnswer returnCode} $testResult break
+	lassign $testResult actualAnswer returnCode
 	if {$returnCode == 1} {
 	    set errorInfo(body) $::errorInfo
 	    set errorCode(body) $::errorCode
@@ -2031,11 +2026,11 @@ proc tcltest::test {name description args} {
 	    if {([preserveCore] > 1) && ($coreFailure)} {
 		append coreMsg "\nMoving file to:\
 		    [file join [temporaryDirectory] core-$name]"
-		catch {file rename -force \
+		catch {file rename -force -- \
 		    [file join [workingDirectory] core] \
 		    [file join [temporaryDirectory] core-$name]
 		} msg
-		if {[string length $msg] > 0} {
+		if {$msg ne {}} {
 		    append coreMsg "\nError:\
 			Problem renaming core file: $msg"
 		}
@@ -2045,7 +2040,7 @@ proc tcltest::test {name description args} {
 
     # check if the return code matched the expected return code
     set codeFailure 0
-    if {!$setupFailure && [lsearch -exact $returnCodes $returnCode] == -1} {
+    if {!$setupFailure && ($returnCode ni $returnCodes)} {
 	set codeFailure 1
     }
 
@@ -2124,7 +2119,7 @@ proc tcltest::test {name description args} {
 		set testFd [open $testFile r]
 		set testLine [expr {[lsearch -regexp \
 			[split [read $testFd] "\n"] \
-			"^\[ \t\]*test [string map {. \\.} $name] "]+1}]
+			"^\[ \t\]*test [string map {. \\.} $name] "] + 1}]
 		close $testFd
 	    }
 	}
@@ -2169,7 +2164,7 @@ proc tcltest::test {name description args} {
 	puts [outputChannel] "---- Return code should have been\
 		one of: $returnCodes"
 	if {[IsVerbose error]} {
-	    if {[info exists errorInfo(body)] && ([lsearch $returnCodes 1]<0)} {
+	    if {[info exists errorInfo(body)] && (1 ni $returnCodes)} {
 		puts [outputChannel] "---- errorInfo: $errorInfo(body)"
 		puts [outputChannel] "---- errorCode: $errorCode(body)"
 	    }
@@ -2250,7 +2245,7 @@ proc tcltest::Skipped {name constraints} {
 	}
 	return 1
     }
-    if {[string equal {} $constraints]} {
+    if {$constraints eq {}} {
 	# If we're limited to the listed constraints and there aren't
 	# any listed, then we shouldn't run the test.
 	if {[limitConstraints]} {
@@ -2401,7 +2396,7 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
 	foreach file $filesMade {
 	    if {[file exists $file]} {
 		DebugDo 1 {Warn "cleanupTests deleting $file..."}
-		catch {file delete -force $file}
+		catch {file delete -force -- $file}
 	    }
 	}
 	set currentFiles {}
@@ -2411,7 +2406,7 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
 	}
 	set newFiles {}
 	foreach file $currentFiles {
-	    if {[lsearch -exact $filesExisted $file] == -1} {
+	    if {$file ni $filesExisted} {
 		lappend newFiles $file
 	    }
 	}
@@ -2494,8 +2489,7 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
 	# then add current file to failFile list if any tests in this
 	# file failed
 
-	if {$currentFailure \
-		&& ([lsearch -exact $failFiles $testFileName] == -1)} {
+	if {$currentFailure && ($testFileName ni $failFiles)} {
 	    lappend failFiles $testFileName
 	}
 	set currentFailure false
@@ -2555,11 +2549,11 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
 		puts [outputChannel] "produced core file! \
 			Moving file to: \
 			[file join [temporaryDirectory] core-$testFileName]"
-		catch {file rename -force \
+		catch {file rename -force -- \
 			[file join [workingDirectory] core] \
 			[file join [temporaryDirectory] core-$testFileName]
 		} msg
-		if {[string length $msg] > 0} {
+		if {$msg ne {}} {
 		    PrintError "Problem renaming file: $msg"
 		}
 	    } else {
@@ -2637,7 +2631,7 @@ proc tcltest::GetMatchingFiles { args } {
 
 	# Add to result list all files in match list and not in skip list
 	foreach file $matchFileList {
-	    if {[lsearch -exact $skipFileList $file] == -1} {
+	    if {$file ni $skipFileList} {
 		lappend matchingFiles $file
 	    }
 	}
@@ -2684,7 +2678,7 @@ proc tcltest::GetMatchingDirectories {rootdir} {
     foreach pattern [matchDirectories] {
 	foreach path [glob -directory $rootdir -types d -nocomplain -- \
 		$pattern] {
-	    if {[lsearch -exact $skipDirs $path] == -1} {
+	    if {$path ni $skipDirs} {
 		set matchDirs [concat $matchDirs [GetMatchingDirectories $path]]
 		if {[file exists [file join $path all.tcl]]} {
 		    lappend matchDirs $path
@@ -2737,7 +2731,7 @@ proc tcltest::runAllTests { {shell ""} } {
 
     # [file system] first available in Tcl 8.4
     if {![catch {file system [testsDirectory]} result]
-	    && ![string equal native [lindex $result 0]]} {
+	    && ([lindex $result 0] ne "native")} {
 	# If we aren't running in the native filesystem, then we must
 	# run the tests in a single process (via 'source'), because
 	# trying to run then via a pipe will fail since the files don't
@@ -2784,10 +2778,10 @@ proc tcltest::runAllTests { {shell ""} } {
 	    # needs to read and process output of children.
 	    set childargv [list]
 	    foreach opt [Configure] {
-		if {[string equal $opt -outfile]} {continue}
+		if {$opt eq "-outfile"} {continue}
 		set value [Configure $opt]
 		# Don't bother passing default configuration options
-		if {[string equal $value $DefaultValue($opt)]} {
+		if {$value eq $DefaultValue($opt)} {
 			continue
 		}
 		lappend childargv $opt $value
@@ -2880,11 +2874,10 @@ proc tcltest::runAllTests { {shell ""} } {
 #     none.
 
 proc tcltest::loadTestedCommands {} {
-    variable l
-    if {[string equal {} [loadScript]]} {
-	return
-    }
-
+variable l
+if {[loadScript] eq {}} {
+return
+}
     return [uplevel 1 [loadScript]]
 }
 
@@ -2927,16 +2920,15 @@ proc tcltest::saveState {} {
 proc tcltest::restoreState {} {
     variable saveState
     foreach p [uplevel 1 {::info procs}] {
-	if {([lsearch [lindex $saveState 0] $p] < 0)
-		&& ![string equal [namespace current]::$p \
-		[uplevel 1 [list ::namespace origin $p]]]} {
+	if {($p ni [lindex $saveState 0]) && ("[namespace current]::$p" ne
+		[uplevel 1 [list ::namespace origin $p]])} {
 
 	    DebugPuts 2 "[lindex [info level 0] 0]: Removing proc $p"
 	    uplevel 1 [list ::catch [list ::rename $p {}]]
 	}
     }
     foreach p [uplevel 1 {::info vars}] {
-	if {[lsearch [lindex $saveState 1] $p] < 0} {
+	if {$p ni [lindex $saveState 1]} {
 	    DebugPuts 2 "[lindex [info level 0] 0]:\
 		    Removing variable $p"
 	    uplevel 1 [list ::catch [list ::unset $p]]
@@ -2997,15 +2989,15 @@ proc tcltest::makeFile {contents name {directory ""}} {
 	     putting ``$contents'' into $fullName"
 
     set fd [open $fullName w]
-    fconfigure $fd -translation lf
-    if {[string equal [string index $contents end] \n]} {
+    chan configure $fd -translation lf
+    if {[string index $contents end] eq "\n"} {
 	puts -nonewline $fd $contents
     } else {
 	puts $fd $contents
     }
     close $fd
 
-    if {[lsearch -exact $filesMade $fullName] == -1} {
+    if {$fullName ni $filesMade} {
 	lappend filesMade $fullName
     }
     return $fullName
@@ -3045,7 +3037,7 @@ proc tcltest::removeFile {name {directory ""}} {
 	    Warn "removeFile removing \"$fullName\":\n  not a file"
 	}
     }
-    return [file delete $fullName]
+    return [file delete -- $fullName]
 }
 
 # tcltest::makeDirectory --
@@ -3075,7 +3067,7 @@ proc tcltest::makeDirectory {name {directory ""}} {
     set fullName [file join $directory $name]
     DebugPuts 3 "[lindex [info level 0] 0]: creating $fullName"
     file mkdir $fullName
-    if {[lsearch -exact $filesMade $fullName] == -1} {
+    if {$fullName ni $filesMade} {
 	lappend filesMade $fullName
     }
     return $fullName
@@ -3116,7 +3108,7 @@ proc tcltest::removeDirectory {name {directory ""}} {
 	    Warn "removeDirectory removing \"$fullName\":\n  not a directory"
 	}
     }
-    return [file delete -force $fullName]
+    return [file delete -force -- $fullName]
 }
 
 # tcltest::viewFile --
@@ -3213,7 +3205,7 @@ proc tcltest::LeakFiles {old} {
     }
     set leak {}
     foreach p $new {
-	if {[lsearch $old $p] < 0} {
+	if {$p ni $old} {
 	    lappend leak $p
 	}
     }
@@ -3284,7 +3276,7 @@ proc tcltest::RestoreLocale {} {
 #
 
 proc tcltest::threadReap {} {
-    if {[info commands testthread] != {}} {
+    if {[info commands testthread] ne {}} {
 
 	# testthread built into tcltest
 
@@ -3304,7 +3296,7 @@ proc tcltest::threadReap {} {
 	}
 	testthread errorproc ThreadError
 	return [llength [testthread names]]
-    } elseif {[info commands thread::id] != {}} {
+    } elseif {[info commands thread::id] ne {}} {
 	
 	# Thread extension
 
@@ -3336,15 +3328,15 @@ namespace eval tcltest {
     # Set up the constraints in the testConstraints array to be lazily
     # initialized by a registered initializer, or by "false" if no
     # initializer is registered.
-    trace variable testConstraints r [namespace code SafeFetch]
+    trace add variable testConstraints read [namespace code SafeFetch]
 
     # Only initialize constraints at package load time if an
     # [initConstraintsHook] has been pre-defined.  This is only
     # for compatibility support.  The modern way to add a custom
     # test constraint is to just call the [testConstraint] command
     # straight away, without all this "hook" nonsense.
-    if {[string equal [namespace current] \
-	    [namespace qualifiers [namespace which initConstraintsHook]]]} {
+    if {[namespace current] eq
+	    [namespace qualifiers [namespace which initConstraintsHook]]} {
 	InitConstraints
     } else {
 	proc initConstraintsHook {} {}
@@ -3381,15 +3373,15 @@ namespace eval tcltest {
 
     proc LoadTimeCmdLineArgParsingRequired {} {
 	set required false
-	if {[info exists ::argv] && [lsearch -exact $::argv -help] != -1} {
+	if {[info exists ::argv] && ("-help" in $::argv)} {
 	    # The command line asks for -help, so give it (and exit)
 	    # right now.  ([configure] does not process -help)
 	    set required true
 	}
 	foreach hook { PrintUsageInfoHook processCmdLineArgsHook
 			processCmdLineArgsAddFlagsHook } {
-	    if {[string equal [namespace current] [namespace qualifiers \
-		    [namespace which $hook]]]} {
+	    if {[namespace current] eq
+		    [namespace qualifiers [namespace which $hook]]} {
 		set required true
 	    } else {
 		proc $hook args {}