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 | core-8-5-branch |
Files: | files | file ages | folders |
SHA1: |
e7ef315c2fb61d087ad25113bb1cee3e |
User & Date: | dgp 2013-01-30 18:58:37 |
Context
2013-01-30
| ||
19:18 | (::platform::LibcVersion): See [Bug 3599098]: Fixed the RE extracting the version to avoid issues w... check-in: e70b932ea4 user: andreask tags: core-8-5-branch | |
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:46 | In the script library, selected modernizations from Patrick Fradin. check-in: df3aac7d79 user: dgp tags: core-8-5-branch | |
Changes
Changes to library/package.tcl.
︙ | ︙ | |||
385 386 387 388 389 390 391 | 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 {} | | < < | 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 | 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 } } |
︙ | ︙ | |||
628 629 630 631 632 633 634 | # $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] { | | < | 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 | # $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 } } |
︙ | ︙ | |||
681 682 683 684 685 686 687 | # process arguments set len [llength $args] if { $len < 6 } { error $err(wrongNumArgs) } # Initialize parameters | | < < < | 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 | # 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" - |
︙ | ︙ | |||
732 733 734 735 736 737 738 | set cmdList {} set lazyFileList {} # Handle -load and -source specs foreach key {load source} { foreach filespec $opts(-$key) { | | < < < < < | 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 | 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.
︙ | ︙ | |||
54 55 56 57 58 59 60 | # 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 | | | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | # 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 |
︙ | ︙ | |||
269 270 271 272 273 274 275 | # 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. | < | | < | 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 | # 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. } } |
︙ | ︙ | |||
355 356 357 358 359 360 361 | # Results # No result. # # Sideeffects # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { | | | 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 | # 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 } |
︙ | ︙ | |||
42 43 44 45 46 47 48 | 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 | | | 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | 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 } } |
︙ | ︙ | |||
78 79 80 81 82 83 84 | # create a slave interpreter, where we override "package ifneeded" set slave [interp create] if {[catch { $slave eval { rename package package_original proc package { args } { | | | 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | # 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] } } |
︙ | ︙ | |||
108 109 110 111 112 113 114 | set P($k) $v } set PKGS "" foreach k [lsort [array names P]] { lappend PKGS $k $P($k) } | | | | | 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 | 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 |
︙ | ︙ |