Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | For [package] etc., select modernizations from Patrick Fradin. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
29a8e457d44b3cc5c3f88be5baaf3afc |
User & Date: | dgp 2013-01-30 19:00:27 |
Context
2013-01-30
| ||
19:27 | (::platform::LibcVersion): See [Bug 3599098]: Fixed the RE extracting the version to avoid issues w... check-in: cc69dcd0b5 user: andreask tags: trunk | |
19:00 | For [package] etc., select modernizations from Patrick Fradin. check-in: 29a8e457d4 user: dgp tags: trunk | |
18:58 | For [package] etc., select modernizations from Patrick Fradin. check-in: e7ef315c2f user: dgp tags: core-8-5-branch | |
17:58 | In the script library, selected modernizations from Patrick Fradin. check-in: e2850774ab user: dgp tags: trunk | |
Changes
Changes to library/package.tcl.
︙ | ︙ | |||
391 392 393 394 395 396 397 | append index "# information so that packages will be loaded automatically\n" append index "# in response to \"package require\" commands. When this\n" append index "# script is sourced, the variable \$dir must contain the\n" append index "# full path name of this file's directory.\n" foreach pkg [lsort [array names files]] { set cmd {} | | < < | 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 | append index "# information so that packages will be loaded automatically\n" append index "# in response to \"package require\" commands. When this\n" append index "# script is sourced, the variable \$dir must contain the\n" append index "# full path name of this file's directory.\n" foreach pkg [lsort [array names files]] { set cmd {} 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 { if {$direct} { set procs {} } lappend cmd "-$type" [list $file $procs] |
︙ | ︙ | |||
540 541 542 543 544 545 546 | # $index now points to the first element of $auto_path that has # changed, or the beginning if $auto_path has changed length Scan the # new elements of $auto_path for directories to add to $use_path. # Don't add directories we've already seen, or ones already on the # $use_path. foreach dir [lrange $auto_path $index end] { | | < | 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 | # $index now points to the first element of $auto_path that has # changed, or the beginning if $auto_path has changed length Scan the # new elements of $auto_path for directories to add to $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)] && ($dir ni $use_path)} { lappend use_path $dir } } set old_path $auto_path } } |
︙ | ︙ | |||
624 625 626 627 628 629 630 | # $index now points to the first element of $auto_path that has # changed, or the beginning if $auto_path has changed length Scan the # new elements of $auto_path for directories to add to $use_path. # Don't add directories we've already seen, or ones already on the # $use_path. foreach dir [lrange $auto_path $index end] { | | < | 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 | # $index now points to the first element of $auto_path that has # changed, or the beginning if $auto_path has changed length Scan the # new elements of $auto_path for directories to add to $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)] && ($dir ni $use_path)} { lappend use_path $dir } } set old_path $auto_path } } |
︙ | ︙ | |||
677 678 679 680 681 682 683 | # process arguments set len [llength $args] if {$len < 6} { error $err(wrongNumArgs) } # Initialize parameters | | < < < | 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 | # process arguments set len [llength $args] if {$len < 6} { error $err(wrongNumArgs) } # Initialize parameters array set opts {-name {} -version {} -source {} -load {}} # process parameters for {set i 0} {$i < $len} {incr i} { set flag [lindex $args $i] incr i switch -glob -- $flag { "-name" - |
︙ | ︙ | |||
728 729 730 731 732 733 734 | set cmdList {} set lazyFileList {} # Handle -load and -source specs foreach key {load source} { foreach filespec $opts(-$key) { | | < | < < < < | | 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 | set cmdList {} set lazyFileList {} # Handle -load and -source specs foreach key {load source} { foreach filespec $opts(-$key) { lassign $filespec filename proclist if { [llength $proclist] == 0 } { set cmd "\[list $key \[file join \$dir [list $filename]\]\]" lappend cmdList $cmd } else { lappend lazyFileList [list $filename $key $proclist] } } } |
︙ | ︙ |
Changes to library/tm.tcl.
︙ | ︙ | |||
50 51 52 53 54 55 56 | # The regex pattern a file name has to match to make it a Tcl Module. set pkgpattern {^([_[:alpha:]][:_[:alnum:]]*)-([[:digit:]].*)[.]tm$} # Export the public API namespace export path | | | 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | # The regex pattern a file name has to match to make it a Tcl Module. set pkgpattern {^([_[:alpha:]][:_[:alnum:]]*)-([[:digit:]].*)[.]tm$} # Export the public API namespace export path namespace ensemble create -command path -subcommands {add remove list} } # ::tcl::tm::path implementations -- # # Public API to the module path. See specification. # # Arguments |
︙ | ︙ | |||
256 257 258 259 260 261 262 | "[::list package provide $pkgname $pkgversion];[::list source -encoding utf-8 $file]" # We abort in this unknown handler only if we got a # satisfying candidate for the requested package. # Otherwise we still have to fallback to the regular # package search to complete the processing. | < | | < | 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 | "[::list package provide $pkgname $pkgversion];[::list source -encoding utf-8 $file]" # We abort in this unknown handler only if we got a # satisfying candidate for the requested package. # Otherwise we still have to fallback to the regular # package search to complete the processing. 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 directory, just # remember to not fall back to the regular search # anymore. } |
︙ | ︙ | |||
343 344 345 346 347 348 349 | # Results # No result. # # Sideeffects # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { | | | 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 | # Results # No result. # # Sideeffects # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { 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} { set px [file join $p ${major}.${n}] if {![interp issafe]} {set px [file normalize $px]} path add $px } |
︙ | ︙ |
Changes to tests/pkgMkIndex.test.
1 2 3 4 5 6 7 8 9 10 | # This file contains tests for the pkg_mkIndex command. # Note that the tests are limited to Tcl scripts only, there are no shared # libraries against which to test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. | < | | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | # This file contains tests for the pkg_mkIndex command. # Note that the tests are limited to Tcl scripts only, there are no shared # libraries against which to test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2 namespace import ::tcltest::* set fullPkgPath [makeDirectory pkg] namespace eval pkgtest { # Namespace for procs we can discard } |
︙ | ︙ | |||
41 42 43 44 45 46 47 | set options "" set argc [llength $args] for {set iarg 0} {$iarg < $argc} {incr iarg} { set a [lindex $args $iarg] if {[regexp {^-} $a]} { lappend options $a | | | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | set options "" set argc [llength $args] for {set iarg 0} {$iarg < $argc} {incr iarg} { set a [lindex $args $iarg] if {[regexp {^-} $a]} { lappend options $a if {$a eq "-load"} { incr iarg lappend options [lindex $args $iarg] } } else { break } } |
︙ | ︙ | |||
77 78 79 80 81 82 83 | # create a slave interpreter, where we override "package ifneeded" set slave [interp create] if {[catch { $slave eval { rename package package_original proc package { args } { | | | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 | # create a slave interpreter, where we override "package ifneeded" set slave [interp create] if {[catch { $slave eval { rename package package_original proc package { args } { if {[lindex $args 0] eq "ifneeded"} { set pkg [lindex $args 1] set ver [lindex $args 2] set ::PKGS($pkg:$ver) [lindex $args 3] } else { return [package_original {*}$args] } } |
︙ | ︙ | |||
107 108 109 110 111 112 113 | set P($k) $v } set PKGS "" foreach k [lsort [array names P]] { lappend PKGS $k $P($k) } | | | | | 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | set P($k) $v } set PKGS "" foreach k [lsort [array names P]] { lappend PKGS $k $P($k) } } err opts]} { set ei [dict get $opts -errorinfo] set ec [dict get $opts -errorcode] catch {interp delete $slave} error $ei $ec } interp delete $slave |
︙ | ︙ |
Changes to tests/tm.test.
︙ | ︙ | |||
196 197 198 199 200 201 202 | ::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] | | | 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 | ::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] lassign [split [package present 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 |
︙ | ︙ |