From ff38415c07817352c9c9f30ae3a5b504afdf8040 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 30 Jan 2013 16:27:54 +0000 Subject: For tcltest, selected modernizations and style improvements from Patrick Fradin. --- library/tcltest/tcltest.tcl | 208 +++++++++++++++++++++----------------------- 1 file 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 {} -- cgit v0.12