diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | doc/pkgMkIndex.n | 20 | ||||
| -rw-r--r-- | library/package.tcl | 76 | ||||
| -rw-r--r-- | tests/pkgMkIndex.test | 30 |
4 files changed, 79 insertions, 56 deletions
@@ -1,3 +1,12 @@ +2000-01-27 Eric Melski <ericm@scriptics.com> + + * tests/pkgMkIndex.test: + * doc/pkgMkIndex.n: + * library/package.tcl: Per rfe #4097, optimized creation of direct + load packages to bypass computing the list of commands added by + the new package. Also made direct loading the default, and added + a -lazy option. + 2000-01-26 Eric Melski <ericm@scriptics.com> * generic/tclNamesp.c: Undid fix for #956, which broke backwards diff --git a/doc/pkgMkIndex.n b/doc/pkgMkIndex.n index bf211e1..cb77b8b 100644 --- a/doc/pkgMkIndex.n +++ b/doc/pkgMkIndex.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: pkgMkIndex.n,v 1.6 1998/12/02 01:42:18 welch Exp $ +'\" RCS: @(#) $Id: pkgMkIndex.n,v 1.7 2000/01/27 19:20:05 ericm Exp $ '\" .so man.macros .TH pkg_mkIndex n 8.0 Tcl "Tcl Built-In Commands" @@ -15,7 +15,7 @@ pkg_mkIndex \- Build an index for automatic loading of packages .SH SYNOPSIS .nf .VS 8.0.3 -\fBpkg_mkIndex ?\fI-direct\fR? ?\fI-load pkgPat\fR? ?\fI-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR? +\fBpkg_mkIndex ?\fI-lazy\fR? ?\fI-load pkgPat\fR? ?\fI-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR? .VE .fi .BE @@ -102,10 +102,10 @@ interpreters. .SH OPTIONS The optional switches are: .TP 15 -\fB\-direct\fR -The generated index -will manage to load the package immediately upon \fBpackage require\fR -instead of delaying loading until actual use of one of the commands. +\fB\-lazy\fR +The generated index will manage to delay loading the package until the +use of one of the commands provided by the package, instead of loading +it immediately upon \fBpackage require\fR. .TP 15 \fB\-load \fIpkgPat\fR The index process will pre-load any packages that exist in the @@ -155,7 +155,7 @@ invoke \fBpackage provide\fR commands to announce the availability of the package, and they setup auto-loader information to load the files of the package. .VS 8.0.3 -Unless the \fI-direct\fR flag was provided when the \fBpkgIndex.tcl\fR +If the \fI-lazy\fR flag was provided when the \fBpkgIndex.tcl\fR was generated, .VE a given file of a given version of a given package isn't @@ -169,15 +169,15 @@ not see the package's commands in the interpreter, but you will be able to invoke the commands and they will be auto-loaded. -.VS 8.0.3 +.VS 8.3.0 .SH "DIRECT LOADING" .PP Some packages, for instance packages which use namespaces and export commands or those which require special initialization, might select that their package files be loaded immediately upon \fBpackage require\fR instead of delaying the actual loading to the first use of one of the -package's command. This mode is enabled when generating the package -index by specifying the \fI-direct\fR argument. +package's command. This is the default mode when generating the package +index. It can be overridden by specifying the \fI-lazy\fR argument. .VE .SH "COMPLEX CASES" diff --git a/library/package.tcl b/library/package.tcl index 22b46d1..6bf7ff1 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -3,7 +3,7 @@ # utility procs formerly in init.tcl which can be loaded on demand # for package management. # -# RCS: @(#) $Id: package.tcl,v 1.6 1999/08/19 02:59:40 hobbs Exp $ +# RCS: @(#) $Id: package.tcl,v 1.7 2000/01/27 19:20:05 ericm Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. @@ -74,7 +74,7 @@ proc pkg_mkIndex {args} { } set more "" - set direct 0 + set direct 1 set doVerbose 0 set loadPat "" for {set idx 0} {$idx < $argCount} {incr idx} { @@ -88,8 +88,11 @@ proc pkg_mkIndex {args} { -verbose { set doVerbose 1 } + -lazy { + set direct 0 + append more " -lazy" + } -direct { - set direct 1 append more " -direct" } -load { @@ -269,38 +272,45 @@ proc pkg_mkIndex {args} { set ::tcl::type source } - # See what new namespaces appeared, and import commands - # from them. Only exported commands go into the index. - - foreach ::tcl::x [::tcl::GetAllNamespaces] { - if {! [info exists ::tcl::namespaces($::tcl::x)]} { - namespace import -force ${::tcl::x}::* + # As a performance optimization, if we are creating + # direct load packages, don't bother figuring out the + # set of commands created by the new packages. We + # only need that list for setting up the autoloading + # used in the non-direct case. + if { !$::tcl::direct } { + # See what new namespaces appeared, and import commands + # from them. Only exported commands go into the index. + + foreach ::tcl::x [::tcl::GetAllNamespaces] { + if {! [info exists ::tcl::namespaces($::tcl::x)]} { + namespace import -force ${::tcl::x}::* + } } - } - - # Figure out what commands appeared - - foreach ::tcl::x [info commands] { - set ::tcl::newCmds($::tcl::x) 1 - } - foreach ::tcl::x $::tcl::origCmds { - catch {unset ::tcl::newCmds($::tcl::x)} - } - foreach ::tcl::x [array names ::tcl::newCmds] { - # reverse engineer which namespace a command comes from - set ::tcl::abs [namespace origin $::tcl::x] - - # special case so that global names have no leading - # ::, this is required by the unknown command - - set ::tcl::abs [auto_qualify $::tcl::abs ::] - - if {[string compare $::tcl::x $::tcl::abs]} { - # Name changed during qualification - - set ::tcl::newCmds($::tcl::abs) 1 - unset ::tcl::newCmds($::tcl::x) + # Figure out what commands appeared + + foreach ::tcl::x [info commands] { + set ::tcl::newCmds($::tcl::x) 1 + } + foreach ::tcl::x $::tcl::origCmds { + catch {unset ::tcl::newCmds($::tcl::x)} + } + foreach ::tcl::x [array names ::tcl::newCmds] { + # reverse engineer which namespace a command comes from + + set ::tcl::abs [namespace origin $::tcl::x] + + # special case so that global names have no leading + # ::, this is required by the unknown command + + set ::tcl::abs [auto_qualify $::tcl::abs ::] + + if {[string compare $::tcl::x $::tcl::abs]} { + # Name changed during qualification + + set ::tcl::newCmds($::tcl::abs) 1 + unset ::tcl::newCmds($::tcl::x) + } } } diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index 7fbb909..17f3223 100644 --- a/tests/pkgMkIndex.test +++ b/tests/pkgMkIndex.test @@ -8,7 +8,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: pkgMkIndex.test,v 1.12 1999/10/19 18:08:44 jenn Exp $ +# RCS: @(#) $Id: pkgMkIndex.test,v 1.13 2000/01/27 19:20:05 ericm Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -261,23 +261,27 @@ proc pkgtest::runIndex { args } { # changed on us test pkgMkIndex-1.1 {nothing matches pattern - current dir is the same} { - list [pkgtest::runIndex $fullPkgPath nomatch.tcl] [pwd] + list [pkgtest::runIndex -lazy $fullPkgPath nomatch.tcl] [pwd] } [list {1 {no files matched glob pattern "nomatch.tcl"}} [pwd]] test pkgMkIndex-2.1 {simple package} { - pkgtest::runIndex $fullPkgPath simple.tcl + pkgtest::runIndex -lazy $fullPkgPath simple.tcl } {0 {{simple:1.0 {tclPkgSetup {simple.tcl source {::simple::lower ::simple::upper}}}}}} test pkgMkIndex-2.2 {simple package - use -direct} { pkgtest::runIndex -direct $fullPkgPath simple.tcl } "0 {{simple:1.0 {source [file join $fullPkgPath simple.tcl]}}}" +test pkgMkIndex-2.3 {simple package - direct loading is default} { + pkgtest::runIndex $fullPkgPath simple.tcl +} "0 {{simple:1.0 {source [file join $fullPkgPath simple.tcl]}}}" + test pkgMkIndex-3.1 {simple package with global symbols} { - pkgtest::runIndex $fullPkgPath global.tcl + pkgtest::runIndex -lazy $fullPkgPath global.tcl } {0 {{global:1.0 {tclPkgSetup {global.tcl source {global_lower global_upper}}}}}} test pkgMkIndex-4.1 {split package} { - pkgtest::runIndex $fullPkgPath pkg2_a.tcl pkg2_b.tcl + pkgtest::runIndex -lazy $fullPkgPath pkg2_a.tcl pkg2_b.tcl } {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}}}} test pkgMkIndex-4.2 {split package - direct loading} { @@ -292,11 +296,11 @@ source [file join $fullPkgPath pkg2_b.tcl]}}}" # Both failures are caused by Tcl code executed in pkgIndex.tcl. test pkgMkIndex-5.1 {requires -direct package} { - pkgtest::runIndex $fullPkgPath std.tcl + pkgtest::runIndex -lazy $fullPkgPath std.tcl } {0 {{std:1.0 {tclPkgSetup {std.tcl source {::std::p1 ::std::p2}}}}}} test pkgMkIndex-6.1 {pkg1 requires pkg3} { - pkgtest::runIndex $fullPkgPath pkg1.tcl pkg3.tcl + pkgtest::runIndex -lazy $fullPkgPath pkg1.tcl pkg3.tcl } {0 {{pkg1:1.0 {tclPkgSetup {pkg1.tcl source {::pkg1::p1-1 ::pkg1::p1-2}}}} {pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}}}} test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} { @@ -304,7 +308,7 @@ test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} { } "0 {{pkg1:1.0 {source [file join $fullPkgPath pkg1.tcl]}} {pkg3:1.0 {source [file join $fullPkgPath pkg3.tcl]}}}" test pkgMkIndex-7.1 {pkg4 uses pkg3} { - pkgtest::runIndex $fullPkgPath pkg4.tcl pkg3.tcl + pkgtest::runIndex -lazy $fullPkgPath pkg4.tcl pkg3.tcl } {0 {{pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}} {pkg4:1.0 {tclPkgSetup {pkg4.tcl source {::pkg4::p4-1 ::pkg4::p4-2}}}}}} test pkgMkIndex-7.2 {pkg4 uses pkg3 - use -direct} { @@ -312,7 +316,7 @@ test pkgMkIndex-7.2 {pkg4 uses pkg3 - use -direct} { } "0 {{pkg3:1.0 {source [file join $fullPkgPath pkg3.tcl]}} {pkg4:1.0 {source [file join $fullPkgPath pkg4.tcl]}}}" test pkgMkIndex-8.1 {pkg5 uses pkg2} { - pkgtest::runIndex $fullPkgPath pkg5.tcl pkg2_a.tcl pkg2_b.tcl + pkgtest::runIndex -lazy $fullPkgPath pkg5.tcl pkg2_a.tcl pkg2_b.tcl } {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}} {pkg5:1.0 {tclPkgSetup {pkg5.tcl source {::pkg5::p5-1 ::pkg5::p5-2}}}}}} test pkgMkIndex-8.2 {pkg5 uses pkg2 - use -direct} { @@ -321,7 +325,7 @@ test pkgMkIndex-8.2 {pkg5 uses pkg2 - use -direct} { source [file join $fullPkgPath pkg2_b.tcl]}} {pkg5:1.0 {source [file join $fullPkgPath pkg5.tcl]}}}" test pkgMkIndex-9.1 {circular packages} { - pkgtest::runIndex $fullPkgPath circ1.tcl circ2.tcl circ3.tcl + pkgtest::runIndex -lazy $fullPkgPath circ1.tcl circ2.tcl circ3.tcl } {0 {{circ1:1.0 {tclPkgSetup {circ1.tcl source {::circ1::c1-1 ::circ1::c1-2 ::circ1::c1-3 ::circ1::c1-4}}}} {circ2:1.0 {tclPkgSetup {circ2.tcl source {::circ2::c2-1 ::circ2::c2-2}}}} {circ3:1.0 {tclPkgSetup {circ3.tcl source ::circ3::c3-1}}}}} # Some tests require the existence of one of the DLLs in the dltest directory @@ -332,16 +336,16 @@ set ::tcltest::testConstraints($dll) [file exists $x] test pkgMkIndex-10.1 {package in DLL and script} $dll { file copy -force $x $fullPkgPath - pkgtest::runIndex $fullPkgPath pkga[info sharedlibextension] pkga.tcl + pkgtest::runIndex -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl } "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}" test pkgMkIndex-10.2 {package in DLL hidden by -load} $dll { - pkgtest::runIndex -load Pkg* -- $fullPkgPath pkga[info sharedlibextension] + pkgtest::runIndex -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension] } {0 {}} # Tolerate "namespace import" at the global scope test pkgMkIndex-11.1 {conflicting namespace imports} { - pkgtest::runIndex $fullPkgPath import.tcl + pkgtest::runIndex -lazy $fullPkgPath import.tcl } {0 {{fubar:1.0 {tclPkgSetup {import.tcl source ::fubar::foo}}}}} # cleanup |