diff options
| -rw-r--r-- | library/package.tcl | 22 | ||||
| -rw-r--r-- | library/tm.tcl | 10 | ||||
| -rw-r--r-- | tests/pkgMkIndex.test | 16 | ||||
| -rw-r--r-- | tests/tm.test | 2 |
4 files changed, 17 insertions, 33 deletions
diff --git a/library/package.tcl b/library/package.tcl index 3831822..06f619c 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -389,9 +389,7 @@ proc pkg_mkIndex {args} { foreach pkg [lsort [array names files]] { set cmd {} - foreach {name version} $pkg { - break - } + lassign $pkg name version lappend cmd ::tcl::Pkg::Create -name $name -version $version foreach spec [lsort -index 0 $files($pkg)] { foreach {file type procs} $spec { @@ -544,8 +542,7 @@ proc tclPkgUnknown {name args} { # $use_path. Don't add directories we've already seen, or ones # already on the $use_path. foreach dir [lrange $auto_path $index end] { - if {![info exists tclSeenPath($dir)] - && ([lsearch -exact $use_path $dir] == -1) } { + if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} { lappend use_path $dir } } @@ -632,8 +629,7 @@ proc tcl::MacOSXPkgUnknown {original name args} { # $use_path. Don't add directories we've already seen, or ones # already on the $use_path. foreach dir [lrange $auto_path $index end] { - if {![info exists tclSeenPath($dir)] - && ([lsearch -exact $use_path $dir] == -1) } { + if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} { lappend use_path $dir } } @@ -685,10 +681,7 @@ proc ::tcl::Pkg::Create {args} { } # Initialize parameters - set opts(-name) {} - set opts(-version) {} - set opts(-source) {} - set opts(-load) {} + array set opts {-name {} -version {} -source {} -load {}} # process parameters for {set i 0} {$i < $len} {incr i} { @@ -736,12 +729,7 @@ proc ::tcl::Pkg::Create {args} { # Handle -load and -source specs foreach key {load source} { foreach filespec $opts(-$key) { - foreach {filename proclist} {{} {}} { - break - } - foreach {filename proclist} $filespec { - break - } + lassign $filespec filename proclist if { [llength $proclist] == 0 } { set cmd "\[list $key \[file join \$dir [list $filename]\]\]" diff --git a/library/tm.tcl b/library/tm.tcl index c5db437..baa268d 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -58,7 +58,7 @@ namespace eval ::tcl::tm { # Export the public API namespace export path - namespace ensemble create -command path -subcommand {add remove list} + namespace ensemble create -command path -subcommands {add remove list} } # ::tcl::tm::path implementations -- @@ -273,10 +273,8 @@ proc ::tcl::tm::UnknownHandler {original name args} { # the regular package search to complete the # processing. - if { - ($pkgname eq $name) && - [package vsatisfies $pkgversion {*}$args] - } then { + if {($pkgname eq $name) + && [package vsatisfies $pkgversion {*}$args]} { set satisfied 1 # We do not abort the loop, and keep adding # provide scripts for every candidate in the @@ -359,7 +357,7 @@ proc ::tcl::tm::Defaults {} { # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { - foreach {major minor} [split [info tclversion] .] break + lassign [split [package present Tcl] .] major minor foreach pa $paths { set p [file join $pa tcl$major] for {set n $minor} {$n >= 0} {incr n -1} { diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index 663a6b2..990bb5f 100644 --- a/tests/pkgMkIndex.test +++ b/tests/pkgMkIndex.test @@ -8,10 +8,8 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} +package require tcltest 2 +namespace import ::tcltest::* set fullPkgPath [makeDirectory pkg] @@ -46,7 +44,7 @@ proc pkgtest::parseArgs { args } { set a [lindex $args $iarg] if {[regexp {^-} $a]} { lappend options $a - if {[string compare -load $a] == 0} { + if {$a eq "-load"} { incr iarg lappend options [lindex $args $iarg] } @@ -82,7 +80,7 @@ proc pkgtest::parseIndex { filePath } { $slave eval { rename package package_original proc package { args } { - if {[string compare [lindex $args 0] ifneeded] == 0} { + if {[lindex $args 0] eq "ifneeded"} { set pkg [lindex $args 1] set ver [lindex $args 2] set ::PKGS($pkg:$ver) [lindex $args 3] @@ -112,9 +110,9 @@ proc pkgtest::parseIndex { filePath } { foreach k [lsort [array names P]] { lappend PKGS $k $P($k) } - } err]} { - set ei $::errorInfo - set ec $::errorCode + } err opts]} { + set ei [dict get $opts -errorinfo] + set ec [dict get $opts -errorcode] catch {interp delete $slave} diff --git a/tests/tm.test b/tests/tm.test index f6c9a68..3f93483 100644 --- a/tests/tm.test +++ b/tests/tm.test @@ -200,7 +200,7 @@ test tm-3.11 {tm: module path management, remove ignores unknown path} -setup { proc genpaths {base} { # Normalizing picks up drive letters on windows [Bug 1053568] set base [file normalize $base] - foreach {major minor} [split [info tclversion] .] break + lassign [split [package present Tcl] .] major minor set results {} set base [file join $base tcl$major] lappend results [file join $base site-tcl] |