diff options
| -rw-r--r-- | changes | 5 | ||||
| -rw-r--r-- | doc/library.n | 13 | ||||
| -rw-r--r-- | doc/pkgMkIndex.n | 98 | ||||
| -rw-r--r-- | library/init.tcl | 475 | ||||
| -rw-r--r-- | tests/pkgMkIndex.test | 77 |
5 files changed, 251 insertions, 417 deletions
@@ -1,6 +1,6 @@ Recent user-visible changes to Tcl: -RCS: @(#) $Id: changes,v 1.30 1998/10/30 00:38:28 welch Exp $ +RCS: @(#) $Id: changes,v 1.31 1998/10/30 23:01:57 welch Exp $ 1. No more [command1] [command2] construct for grouping multiple commands on a single command line. @@ -3660,3 +3660,6 @@ Thanks to Donald Porter and Tom Silva for related patches. (BW) of Tcl_RegisterChannel so that 1) unregistered channels do not get closed after their first fileevent, and 2) errors that occur during close in a fileevent script are actually reflected by the close command. (BW) + +10/30/98 (bug fix) Overhaul of pkg_mkIndex to deal with transitive +package requires and packages split among scripts and binary files. (BW) diff --git a/doc/library.n b/doc/library.n index c7292e8..a760c04 100644 --- a/doc/library.n +++ b/doc/library.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: library.n,v 1.4 1998/09/14 18:39:53 stanton Exp $ +'\" RCS: @(#) $Id: library.n,v 1.5 1998/10/30 23:02:02 welch Exp $ .so man.macros .TH library n "8.0" Tcl "Tcl Built-In Commands" .BS @@ -238,17 +238,24 @@ any commands. \fBauto_path\fR If set, then it must contain a valid Tcl list giving directories to search during auto-load operations. +This variable is initialized during startup to contain, in order: +the directories listed in the TCLLIBPATH environment variable, +the directory named by the $tcl_library variable, +the parent directory of $tcl_library, +the directories listed in the $tcl_pkgPath variable. .TP \fBenv(TCL_LIBRARY)\fR If set, then it specifies the location of the directory containing -library scripts (the value of this variable will be returned by +library scripts (the value of this variable will be +assigned to the \fBtcl_library\fR variable and therefore returned by the command \fBinfo library\fR). If this variable isn't set then a default value is used. .TP \fBenv(TCLLIBPATH)\fR If set, then it must contain a valid Tcl list giving directories to search during auto-load operations. -This variable is only used if \fBauto_path\fR is not defined. +This variable is only used when +initializing the \fBauto_path\fR variable. .TP \fBtcl_nonwordchars\fR .VS diff --git a/doc/pkgMkIndex.n b/doc/pkgMkIndex.n index 5ac1a9d..e4bcf78 100644 --- a/doc/pkgMkIndex.n +++ b/doc/pkgMkIndex.n @@ -4,10 +4,10 @@ '\" 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.3 1998/10/17 00:16:38 escoffon Exp $ +'\" RCS: @(#) $Id: pkgMkIndex.n,v 1.4 1998/10/30 23:02:02 welch Exp $ '\" .so man.macros -.TH pkg_mkIndex n 7.6 Tcl "Tcl Built-In Commands" +.TH pkg_mkIndex n 8.0 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -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-verbose\fR? ?\fI-nopkgrequire\fR? \fIdir\fR ?\fIpattern pattern ...\fR? +\fBpkg_mkIndex ?\fI-direct\fR? ?\fI-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR? .VE .fi .BE @@ -47,6 +47,8 @@ If the optional \fI-direct\fR argument is given, 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. .VE +.RS +.LP \fBPkg_mkIndex\fR will create a file \fBpkgIndex.tcl\fR in \fIdir\fR with package information about all the files given by the \fIpattern\fR arguments. @@ -54,6 +56,11 @@ It does this by loading each file and seeing what packages and new commands appear (this is why it is essential to have \fBpackage provide\fR commands or \fBTcl_PkgProvide\fR calls in the files, as described above). +If you have a package split among scripts and binary files, +or if you have dependencies among files, +you may have to adjust the order in which \fBpkg_mkIndex\fR processes +the files. See COMPLEX CASES below. +.RE .IP [3] Install the package as a subdirectory of one of the directories given by the \fBtcl_pkgPath\fR variable. If \fB$tcl_pkgPath\fR contains more @@ -156,39 +163,60 @@ package's command. This mode is enabled when generating the package index by specifying the \fI-direct\fR argument. .VE -.VS 8.0.3 -.SH "INDEXING OF DEPENDENT PACKAGES" +.SH "COMPLEX CASES" +Most complex cases of dependencies among scripts +and binary files, and packages being split among scripts and +binary files are handled OK. However, you may have to adjust +the order in which files are processed by \fBpkg_mkIndex\fR. +The only case that is not supported is a package that is +provided by more than one binary file. +These issues are described in detail below. .PP -Earlier versions of \fBpkg_mkIndex\fR were unable to handle some packages -that did a \fIpackage require\fR for a second package also to be indexed, -and then proceeded to execute -code from that package (for example in a \fInamespace eval\fR construct). -This happended because the autoloading mechanism did not have access to -the index file being built, thus causing \fIpackage require\fR to fail. -\fBPkg_mkIndex\fR circumvented this problem by redefining -\fIpackage require\fR to be a null operation, which in turn then caused the -indexing to fail when procedures from the second package were being called -in the first. -.LP -\fBPkg_mkIndex\fR now implements \fIpackage require\fR. Additionally, it -does the indexing in multiple passes, until either -all files have been indexed, or until the current pass could index no more -files. For each pass, files that were indexed are added to a partial -\fBpkgIndex.tcl\fR, which is reloaded at the start of each pass. In the case -described above, for example, \fBpkg_mkIndex\fR will do two passes. During the -first pass, the first package will not index, but the second will. Then, -during the second pass, the first package will be able to -\fIpackage require\fR the second, and therefore will also be indexed. -If the \fI-verbose\fR optional argument is givem, \fBpkg_mkIndex\fR will -display its progress. -.LP -Under some conditions, \fBpkg_mkIndex\fR may not be able to index any file -during a pass; for example, if package \fIa\fR requires package \fIb\fR, -and package \fIb\fR requires package \fIa\fR, neither one can be indexed. -In these situations, you can give the \fI-nopkgrequire\fR optional argument; -this will cause \fBpkg_mkIndex\fR to revert to the old behaviour, where -\fIpackage require\fR is a null operation. -.VE +If each script or file contains one package, and packages +are only contained in one file, then things are easy. +You simply specify all files to be indexed in any order +with some glob patterns. +.PP +In general, it is OK for scripts to have dependencies on other +packages. +If scripts contain \fBpackage require\fP commands, these are +stubbed out in the interpreter used to process the scripts, +so these do not cause problems. +If scripts call into other packages in global code, +these calls are handled by a stub \fBunknown\fP command. +However, if scripts make variable references to other package's +variables in global code, these will cause errors. That is +also bad coding style. +.PP +If binary files have dependencies on other packages, things +can become tricky because it is not possible to stub out +the C-level \fBTcl_PkgRequire\fP API. +For example, suppose the BLT package requires Tk, and expresses +this with a call to \fBTcl_PkgRequire\fP in its \fBBlt_Init\fP routine. +To support this, you must run \fBpkg_mkIndex\fR in a shell that +has Tk loaded. \fBpkg_mkIndex\fR will load any packages listed by +\fBinfo loaded\fP into the interpreter used to process files. +In most cases this will satisfy the \fBTcl_PkgRequire\fP calls +made by binary files. +.PP +If you are indexing two binary files and one depends on the other, +you should specify the one that has dependencies last. +This way the one without dependencies will get loaded and indexed, +and then the package it provides +will be available when the second file is processed. +.PP +You cannot have the same package provided by two different binary +files. Well, you can, but they cannot be indexed by \fBpkg_mkIndex\fR +and it seems like a poor design choice anyway. The problem is that +once the package is provided by the first binary file, then that +masks the provide made by the other binary file. If you +absolutely must do this, you'll have to run \fBpkg_mkIndex\fR on +each different file, save the resulting pkgIndex.tcl files, +and merge the results. +.PP +If you have a package that is split across scripts and a binary file, +then you must specify the scripts first; otherwise the package loaded from +the binary file may mask the package defined by the scripts. .SH KEYWORDS auto-load, index, package, version diff --git a/library/init.tcl b/library/init.tcl index 1dba84d..ce40d8d 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -3,7 +3,7 @@ # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # -# RCS: @(#) $Id: init.tcl,v 1.17 1998/10/23 22:22:15 welch Exp $ +# RCS: @(#) $Id: init.tcl,v 1.18 1998/10/30 23:02:02 welch Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -578,7 +578,8 @@ proc auto_reset {} { global auto_execs auto_index auto_oldpath foreach p [info procs] { if {[info exists auto_index($p)] && ![string match auto_* $p] - && ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup tcl_findLibrary + && ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup + tcl_findLibrary pkg_compareExtension tclMacPkgSearch tclPkgUnknown} $p] < 0)} { rename $p {} } @@ -1081,23 +1082,16 @@ if {$::tcl_platform(platform) == "windows"} { if {[string compare $ext {}] == 0} { set ext [info sharedlibextension] } - set cmp [string compare \ - [string tolower [file extension $fileName]] \ - [string tolower $ext]] - if {$cmp} { - return 0 - } - return 1 + return [expr {[string compare \ + [string tolower [file extension $fileName]] \ + [string tolower $ext]] == 0}] } } else { proc pkg_compareExtension { fileName {ext {}} } { if {[string compare $ext {}] == 0} { set ext [info sharedlibextension] } - if {[string compare [file extension $fileName] $ext]} { - return 0 - } - return 1 + return [expr {[string compare [file extension $fileName] $ext] == 0}] } } @@ -1114,19 +1108,9 @@ if {$::tcl_platform(platform) == "windows"} { # loaded when "package require" is executed, rather # than lazily when the first reference to an exported # procedure in the package is made. -# -nopkgrequire (optional) If this flag is present, "package require" -# commands are ignored. This flag is useful in some -# situations, for example when there is a circularity -# in package requires (package a requires package b, -# which in turns requires package a). # -verbose (optional) Verbose output; the name of each file that # was successfully rocessed is printed out. Additionally, -# if processing of a file failed a message is printed -# out; a file failure may not indicate that the indexing -# has failed, since pkg_mkIndex stores the list of failed -# files and tries again. The second time the processing -# may succeed, for example if a required package has been -# indexed by a previous pass. +# if processing of a file failed a message is printed. # dir - Name of the directory in which to create the index. # args - Any number of additional arguments, each giving # a glob pattern that matches the names of one or @@ -1135,7 +1119,7 @@ if {$::tcl_platform(platform) == "windows"} { proc pkg_mkIndex {args} { global errorCode errorInfo - set usage {"pkg_mkIndex ?-nopkgrequire? ?-direct? ?-verbose? dir ?pattern ...?"}; + set usage {"pkg_mkIndex ?-direct? ?-verbose? dir ?pattern ...?"}; set argCount [llength $args] if {$argCount < 1} { @@ -1144,7 +1128,6 @@ proc pkg_mkIndex {args} { set more "" set direct 0 - set noPkgRequire 0 set doVerbose 0 for {set idx 0} {$idx < $argCount} {incr idx} { set flag [lindex $args $idx] @@ -1154,25 +1137,16 @@ proc pkg_mkIndex {args} { incr idx break } - -verbose { set doVerbose 1 } - -direct { set direct 1 append more " -direct" } - - -nopkgrequire { - set noPkgRequire 1 - append more " -nopkgrequire" - } - -* { return -code error "unknown flag $flag: should be\n$usage" } - default { # done with the flags break @@ -1198,329 +1172,192 @@ proc pkg_mkIndex {args} { set oldDir [pwd] cd $dir - # In order to support building of index files from scratch, we make - # repeated passes on the files to index, until either all have been - # indexed, or we can no longer make any headway. - - if {[catch { - foreach file [eval glob $patternList] { - set toProcess($file) 1 - } - } err]} { - set ei $::errorInfo - set ec $::errorCode + if {[catch {eval glob $patternList} fileList]} { + global errorCode errorInfo cd $oldDir - error $err $ei $ec + return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList } + foreach file $fileList { + # For each file, figure out what commands and packages it provides. + # To do this, create a child interpreter, load the file into the + # interpreter, and get a list of the new commands and packages + # that are defined. - while {[array size toProcess] > 0} { - set processed 0 - - foreach file [array names toProcess] { - # For each file, figure out what commands and packages it provides. - # To do this, create a child interpreter, load the file into the - # interpreter, and get a list of the new commands and packages - # that are defined. The interpeter uses a special version of - # tclPkgSetup to force loading of required packages at require - # time rather than lazily, so that we can keep track of commands - # and packages that are defined indirectly rather than from the - # file itself. + if {[string compare $file "pkgIndex.tcl"] == 0} { + continue + } - set c [interp create] + set c [interp create] - # Load into the child all packages currently loaded in the parent - # interpreter, in case the extension depends on some of them. + # Load into the child all packages currently loaded in the parent + # interpreter, in case the extension depends on some of them. - foreach pkg [info loaded] { - if {[lindex $pkg 1] == "Tk"} { - $c eval {set argv {-geometry +0+0}} - } - load [lindex $pkg 0] [lindex $pkg 1] $c + foreach pkg [info loaded] { + if {[lindex $pkg 1] == "Tk"} { + $c eval {set argv {-geometry +0+0}} } + load [lindex $pkg 0] [lindex $pkg 1] $c + } - # We also call package ifneeded for all packages that have been - # identified so far. This way, each pass will have loaded the - # equivalent of the pkgIndex.tcl file that we are constructing, - # and packages whose processing failed in previous passes may - # be processed successfully now. - # Note that the $dir value is hardwired to ".", because we are - # in the directory with the .tcl files. - - foreach pkg [array names files] { - $c eval "package ifneeded $pkg\ - \[list tclPkgSetup . \ - [lrange $pkg 0 0] [lrange $pkg 1 1]\ - [list $files($pkg)]\]" - } - if {$noPkgRequire == 1} { - $c eval { - rename package __package_orig - proc package {what args} { - switch -- $what { - require { return ; # ignore transitive requires } - default { eval __package_orig {$what} $args } - } - } - proc __dummy args {} - package unknown __dummy - } - } else { - $c eval { - rename package __package_orig - proc package {what args} { - switch -- $what { - require { - eval __package_orig require $args - - # a package that was required needs to be - # placed in the list of packages to ignore. - # tclPkgSetup is unable to do it, so do it - # here. - - set ::__ignorePkgs([lindex $args 0]) 1 - } - - provide { - # if package provide is called at level 1 and - # with two arguments, then this package is - # being provided by one of the files we are - # indexing, and therefore we need to add it - # to the list of packages to write out. - # We need to do this check because otherwise - # packages that are spread over multiple - # files are indexed only by their first file - # loaded. - # Note that that this cannot detect - # packages that are implemented by a - # combination of TCL files and DLLs - - if {([info level] == 1) \ - && ([llength $args] == 2)} { - lappend ::__providedPkgs [lindex $args 0] - } - - eval __package_orig provide $args - } - - default { eval __package_orig {$what} $args } - } - } + $c eval { + # Stub out the package command so packages can + # require other packages. + + rename package __package_orig + proc package {what args} { + switch -- $what { + require { return ; # ignore transitive requires } + default { eval __package_orig {$what} $args } } } + proc tclPkgUnknown args {} + package unknown tclPkgUnknown - # make sure that the auto_path in the slave is consistent - # with ours - $c eval [list set auto_path $::auto_path] - - $c eval [list set __file $file] - $c eval [list set __direct $direct] - if {[catch { - $c eval { - set __doingWhat "loading or sourcing" - - # override the tclPkgSetup procedure (which is called by - # package ifneeded statements from pkgIndex.tcl) to force - # loads of packages, and also keep track of - # packages/namespaces/commands that the load generated - - proc tclPkgSetup {dir pkg version files} { - # remember the current set of packages and commands, - # so that we can add any that were defined by the - # package files to the list of packages and commands - # to ignore - - foreach __p [package names] { - set __localIgnorePkgs($__p) 1 - } - foreach __ns [__pkgGetAllNamespaces] { - set __localIgnoreNs($__ns) 1 + # Stub out the unknown command so package can call + # into each other during their initialilzation. - # if the namespace is already in the __ignoreNs - # array, its commands have already been imported + proc unknown {args} {} - if {[info exists ::__ignoreNs($__ns)] == 0} { - namespace import ${__ns}::* - } - } - foreach __cmd [info commands] { - set __localIgnoreCmds($__cmd) 1 - } - - # load the files that make up the package - - package provide $pkg $version - foreach __fileInfo $files { - set __f [lindex $__fileInfo 0] - set __type [lindex $__fileInfo 1] - if {$__type == "load"} { - load [file join $dir $__f] $pkg - } else { - source [file join $dir $__f] - } - } + # Stub out the auto_import mechanism - # packages and commands that were defined by these - # files are to be ignored. + proc auto_import {args} {} - foreach __p [package names] { - if {[info exists __localIgnorePkgs($__p)] == 0} { - set ::__ignorePkgs($__p) 1 - } - } - foreach __ns [__pkgGetAllNamespaces] { - if {([info exists __localIgnoreNs($__ns)] == 0) \ - && ([info exists ::__ignoreNs($__ns)] == 0)} { - namespace import ${__ns}::* - set ::__ignoreNs($__ns) 1 - } - } - foreach __cmd [info commands] { - if {[info exists __localIgnoreCmds($__cmd)] == 0} { - lappend ::__ignoreCmds $__cmd - } - } - } + # reserve the ::tcl namespace for support procs + # and temporary variables. This might make it awkward + # to generate a pkgIndex.tcl file for the ::tcl namespace. - # we need to track command defined by each package even in - # the -direct case, because they are needed internally by - # the "partial pkgIndex.tcl" step above. + namespace eval ::tcl { + variable file ;# Current file being processed + variable direct ;# -direct flag value + variable x ;# Loop variable + variable debug ;# For debugging + variable type ;# "load" or "source", for -direct + variable namespaces ;# Existing namespaces (e.g., ::tcl) + variable packages ;# Existing packages (e.g., Tcl) + variable origCmds ;# Existing commands + variable newCmds ;# Newly created commands + variable newPkgs {} ;# Newly created packages + } + } - proc __pkgGetAllNamespaces {{root {}}} { - set __list $root - foreach __ns [namespace children $root] { - eval lappend __list [__pkgGetAllNamespaces $__ns] - } - return $__list - } + $c eval [list set ::tcl::file $file] + $c eval [list set ::tcl::direct $direct] + if {[catch { + $c eval { + set ::tcl::debug "loading or sourcing" - # initialize the list of packages to ignore; these are - # packages that are present before the script/dll is loaded + # we need to track command defined by each package even in + # the -direct case, because they are needed internally by + # the "partial pkgIndex.tcl" step above. - set ::__ignorePkgs(Tcl) 1 - set ::__ignorePkgs(Tk) 1 - foreach __pkg [package names] { - set ::__ignorePkgs($__pkg) 1 + proc ::tcl::GetAllNamespaces {{root ::}} { + set list $root + foreach ns [namespace children $root] { + eval lappend list [::tcl::GetAllNamespaces $ns] } + return $list + } - # before marking the original commands, import all the - # namespaces that may have been loaded from the parent; - # these namespaces and their commands are to be ignored + # initialize the list of existing namespaces, packages, commands - foreach __ns [__pkgGetAllNamespaces] { - set ::__ignoreNs($__ns) 1 - namespace import ${__ns}::* - } - - set ::__ignoreCmds [info commands] - - set dir "" ;# in case file is pkgIndex.tcl - - # Try to load the file if it has the shared library - # extension, otherwise source it. It's important not to - # try to load files that aren't shared libraries, because - # on some systems (like SunOS) the loader will abort the - # whole application when it gets an error. - - set __pkgs {} - set __providedPkgs {} - if {[pkg_compareExtension $__file [info sharedlibextension]]} { - # The "file join ." command below is necessary. - # Without it, if the file name has no \'s and we're - # on UNIX, the load command will invoke the - # LD_LIBRARY_PATH search mechanism, which could cause - # the wrong file to be used. - - set __doingWhat loading - load [file join . $__file] - set __type load - } else { - set __doingWhat sourcing - source $__file - set __type source - } + foreach ::tcl::x [::tcl::GetAllNamespaces] { + set ::tcl::namespaces($::tcl::x) 1 + } + foreach ::tcl::x [package names] { + set ::tcl::packages($::tcl::x) 1 + } + set ::tcl::origCmds [info commands] + + # Try to load the file if it has the shared library + # extension, otherwise source it. It's important not to + # try to load files that aren't shared libraries, because + # on some systems (like SunOS) the loader will abort the + # whole application when it gets an error. + + if {[pkg_compareExtension $::tcl::file [info sharedlibextension]]} { + # The "file join ." command below is necessary. + # Without it, if the file name has no \'s and we're + # on UNIX, the load command will invoke the + # LD_LIBRARY_PATH search mechanism, which could cause + # the wrong file to be used. + + set ::tcl::debug loading + load [file join . $::tcl::file] + set ::tcl::type load + } else { + set ::tcl::debug sourcing + source $::tcl::file + set ::tcl::type source + } - # Using __ variable names to avoid potential namespaces - # clash, even here in post processing because the - # loaded package could have set up traces,... + # See what new namespaces appeared, and import commands + # from them. Only exported commands go into the index. - foreach __ns [__pkgGetAllNamespaces] { - if {[info exists ::__ignoreNs($__ns)] == 0} { - namespace import ${__ns}::* - } - } - foreach __i [info commands] { - set __cmds($__i) 1 + foreach ::tcl::x [::tcl::GetAllNamespaces] { + if {! [info exists ::tcl::namespaces($::tcl::x)]} { + namespace import ${::tcl::x}::* } - foreach __i $::__ignoreCmds { - catch {unset __cmds($__i)} - } - foreach __i [array names __cmds] { - # reverse engineer which namespace a command comes from - - set __absolute [namespace origin $__i] + } - # special case so that global names have no leading - # ::, this is required by the unknown command + # Figure out what commands appeared - set __absolute [auto_qualify $__absolute ::] + 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] - if {[string compare $__i $__absolute] != 0} { - set __cmds($__absolute) 1 - unset __cmds($__i) - } + # special case so that global names have no leading + # ::, this is required by the unknown command - # final check, to support packages spread over - # multiple files: if the new command is in the - # namespace of an ignored package, de-ignore it. + set ::tcl::abs [auto_qualify $::tcl::abs ::] - regsub {^::} [namespace qualifiers $__absolute] {} __qual - if {[info exists ::__ignorePkgs($__qual)]} { - unset ::__ignorePkgs($__qual) - } - } + if {[string compare $::tcl::x $::tcl::abs] != 0} { + # Name changed during qualification - foreach __i $::__providedPkgs { - lappend __pkgs [list $__i [package provide $__i]] - set __ignorePkgs($__i) 1 - } - foreach __i [package names] { - if {([string compare [package provide $__i] ""] != 0) \ - && ([info exists ::__ignorePkgs($__i)] == 0)} { - lappend __pkgs [list $__i [package provide $__i]] - } + set ::tcl::newCmds($::tcl::abs) 1 + unset ::tcl::newCmds($::tcl::x) } } - } msg] == 1} { - set what [$c eval set __doingWhat] - if {$doVerbose} { - tclLog "warning: error while $what $file: $msg\nthis file will be retried in the next pass" - } - } else { - set type [$c eval set __type] - set cmds [lsort [$c eval array names __cmds]] - set pkgs [$c eval set __pkgs] - if {[llength $pkgs] > 1} { - tclLog "warning: \"$file\" provides more than one package ($pkgs)" - } - foreach pkg $pkgs { - # cmds is empty/not used in the direct case - lappend files($pkg) [list $file $type $cmds] - } - incr processed - unset toProcess($file) + # Look through the packages that appeared, and if there is + # a version provided, then record it - if {$doVerbose} { - tclLog "processed $file" + foreach ::tcl::x [package names] { + if {([string compare [package provide $::tcl::x] ""] != 0) \ + && ![info exists ::tcl::packages($::tcl::x)]} { + lappend ::tcl::newPkgs \ + [list $::tcl::x [package provide $::tcl::x]] + } } } - interp delete $c - } + } msg] == 1} { + set what [$c eval set ::tcl::debug] + if {$doVerbose} { + tclLog "warning: error while $what $file: $msg" + } + } else { + set type [$c eval set ::tcl::type] + set cmds [lsort [$c eval array names ::tcl::newCmds]] + set pkgs [$c eval set ::tcl::newPkgs] + if {[llength $pkgs] > 1} { + tclLog "warning: \"$file\" provides more than one package ($pkgs)" + } + foreach pkg $pkgs { + # cmds is empty/not used in the direct case + lappend files($pkg) [list $file $type $cmds] + } - if {$processed == 0} { - tclLog "this iteration could not process any files: giving up here" - break + if {$doVerbose} { + tclLog "processed $file" + } } + interp delete $c } foreach pkg [lsort [array names files]] { diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index f30c8ea..a91b158 100644 --- a/tests/pkgMkIndex.test +++ b/tests/pkgMkIndex.test @@ -8,7 +8,7 @@ # Copyright (c) 1998 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: pkgMkIndex.test,v 1.1 1998/10/17 00:21:39 escoffon Exp $ +# RCS: @(#) $Id: pkgMkIndex.test,v 1.2 1998/10/30 23:02:03 welch Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -17,15 +17,8 @@ if {[string compare test [info procs test]] == 1} then {source defs} # Make sure that the path to pkg1 is absolute. set scriptDir [file dirname [info script]] -if {[string compare [file pathtype $scriptDir] relative] == 0} { - set oldDir [pwd] - catch { - cd [file join [pwd] $scriptDir] - set scriptDir [pwd] - } - cd $oldDir -} -lappend auto_path [file join $scriptDir pkg1] +set oldDir [pwd] +lappend auto_path [file join [pwd] $scriptDir pkg1] # pkgproc -- # @@ -279,7 +272,7 @@ pkgproc runIndex { args } { test pkgMkIndex-1.1 {nothing matches pattern - current dir is the same} { list [runIndex pkg nomatch.tcl] [pwd] } [list {1 {no files matched glob pattern "nomatch.tcl"}} [pwd]] - +cd $oldDir ;# 'cause 8.0.3 is left in the wrong place test pkgMkIndex-2.1 {simple package} { runIndex pkg simple.tcl } {0 {{simple:1.0 {tclPkgSetup {simple.tcl source {::simple::lower ::simple::upper}}}}}} @@ -311,10 +304,6 @@ test pkgMkIndex-5.1 {requires -direct package} { runIndex pkg std.tcl } {0 {{std:1.0 {tclPkgSetup {std.tcl source {::std::p1 ::std::p2}}}}}} -test pkgMkIndex-5.2 {requires -direct package - use -nopkgrequire} { - runIndex -nopkgrequire pkg std.tcl -} {0 {{std:1.0 {tclPkgSetup {std.tcl source {::std::p1 ::std::p2}}}}}} - test pkgMkIndex-6.1 {pkg1 requires pkg3} { runIndex pkg 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}}}}}} @@ -323,14 +312,6 @@ test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} { runIndex -direct pkg pkg1.tcl pkg3.tcl } {0 {{pkg1:1.0 {source pkg/pkg1.tcl}} {pkg3:1.0 {source pkg/pkg3.tcl}}}} -test pkgMkIndex-6.3 {pkg1 requires pkg3 - use -nopkgrequire} { - runIndex -nopkgrequire pkg 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.4 {pkg1 requires pkg3 - use -direct -nopkgrequire} { - runIndex -direct -nopkgrequire pkg pkg1.tcl pkg3.tcl -} {0 {{pkg1:1.0 {source pkg/pkg1.tcl}} {pkg3:1.0 {source pkg/pkg3.tcl}}}} - test pkgMkIndex-7.1 {pkg4 uses pkg3} { runIndex pkg 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}}}}}} @@ -339,19 +320,6 @@ test pkgMkIndex-7.2 {pkg4 uses pkg3 - use -direct} { runIndex -direct pkg pkg4.tcl pkg3.tcl } {0 {{pkg3:1.0 {source pkg/pkg3.tcl}} {pkg4:1.0 {source pkg/pkg4.tcl}}}} -# Should pkg_mkIndex throw an error if not all packages are indexed? -# Currently it doesn't, and that's why there is a "success". -# The error marker was set at 1 so that the fail tests as a reminder to -# look at pkg_mkIndex behaviour on errors like these - -test pkgMkIndex-7.3 {pkg4 uses pkg3 - use -nopkgrequire} { - runIndex -nopkgrequire pkg pkg4.tcl pkg3.tcl -} {1 {{pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}}}} - -test pkgMkIndex-7.4 {pkg4 uses pkg3 - use -direct -nopkgrequire} { - runIndex -direct -nopkgrequire pkg pkg4.tcl pkg3.tcl -} {1 {{pkg3:1.0 {source pkg/pkg3.tcl}}}} - test pkgMkIndex-8.1 {pkg5 uses pkg2} { runIndex pkg 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}}}}}} @@ -361,36 +329,26 @@ test pkgMkIndex-8.2 {pkg5 uses pkg2 - use -direct} { } {0 {{pkg2:1.0 {source pkg/pkg2_a.tcl source pkg/pkg2_b.tcl}} {pkg5:1.0 {source pkg/pkg5.tcl}}}} -# Should pkg_mkIndex throw an error if not all packages are indexed? -# Currently it doesn't, and that's why there is a "success". -# The error marker was set at 1 so that the fail tests as a reminder to -# look at pkg_mkIndex behaviour on errors like these - -test pkgMkIndex-8.3 {pkg5 uses pkg2 - use -nopkgrequire} { - runIndex -nopkgrequire pkg pkg5.tcl pkg2_a.tcl pkg2_b.tcl -} {1 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}}}} - -test pkgMkIndex-8.4 {pkg5 uses pkg2 - use -direct -nopkgrequire} { - runIndex -direct -nopkgrequire pkg pkg5.tcl pkg2_a.tcl pkg2_b.tcl -} {1 {{pkg2:1.0 {source pkg/pkg2_a.tcl -source pkg/pkg2_b.tcl}}}} - -# Should pkg_mkIndex throw an error if not all packages are indexed? -# Currently it doesn't, and that's why there is a "success". -# The error marker was set at 1 so that the fail tests as a reminder to -# look at pkg_mkIndex behaviour on errors like these - test pkgMkIndex-9.1 {circular packages} { runIndex pkg circ1.tcl circ2.tcl circ3.tcl -} {1 {}} - -test pkgMkIndex-9.2 {circular packages - use -nopkgrequire} { - runIndex -nopkgrequire pkg 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}}}}} +# Try to find one of the DLLs in the dltest directory +set x [file join [pwd] [file dirname [info script]]] +set x [file join $x ../unix/dltest/pkga[info sharedlibextension]] +if {[file exists $x]} { + file copy -force $x pkg + test pkgMkIndex-10.1 {package in DLL and script} { + runIndex pkg pkga.tcl pkga[info sharedlibextension] + } {0 {{Pkga:1.0 {tclPkgSetup {pkga.tcl source pkga_neq} {pkga.so load {pkga_eq pkga_quote}}}}}} +} else { + puts "Skipping pkgMkIndex-10.1 (index of DLL and script)" +} + # # cleanup # +if {![info exist TESTS]} { file delete [file join pkg pkgIndex.tcl] @@ -400,3 +358,4 @@ foreach p $::procList { unset ::procList unset ::pkgDriverCount +} |