From e506fbc42c805d0a6dfe2982a6169a0397aeddad Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 28 Nov 2016 13:17:47 +0000 Subject: Complete implementation, tests and documentation --- doc/info.n | 7 +-- doc/package.n | 8 ++++ generic/tclCmdMZ.c | 27 ++++++++++- generic/tclInt.h | 1 + generic/tclInterp.c | 19 +++++++- generic/tclPkg.c | 24 ++++++---- library/init.tcl | 2 +- library/package.tcl | 2 +- library/tclIndex | 134 ++++++++++++++++++++++++++-------------------------- tests/package.test | 2 +- 10 files changed, 140 insertions(+), 86 deletions(-) diff --git a/doc/info.n b/doc/info.n index 477e272..01ca10b 100644 --- a/doc/info.n +++ b/doc/info.n @@ -297,10 +297,11 @@ scripts are stored. This is actually the value of the \fBtcl_library\fR variable and may be changed by setting \fBtcl_library\fR. .TP -\fBinfo loaded \fR?\fIinterp\fR? +\fBinfo loaded \fR?\fIinterp\fR? \fR?\fIpackage\fR? . -Returns a list describing all of the packages that have been loaded into -\fIinterp\fR with the \fBload\fR command. +Returns the filename loaded as part of \fIpackage\fR. If \fIpackage\fR +is not specified, returns a list describing all of the packages +that have been loaded into \fIinterp\fR with the \fBload\fR command. Each list element is a sub-list with two elements consisting of the name of the file from which the package was loaded and the name of the package. diff --git a/doc/package.n b/doc/package.n index 47b2aa6..5687480 100644 --- a/doc/package.n +++ b/doc/package.n @@ -12,6 +12,7 @@ package \- Facilities for package loading and version control .SH SYNOPSIS .nf +\fBpackage files\fR \fIpackage\fR \fBpackage forget\fR ?\fIpackage package ...\fR? \fBpackage ifneeded \fIpackage version\fR ?\fIscript\fR? \fBpackage names\fR @@ -43,6 +44,13 @@ primarily by system scripts that maintain the package database. The behavior of the \fBpackage\fR command is determined by its first argument. The following forms are permitted: .TP +\fBpackage files\fR \fIpackage\fR +. +Lists all files forming part of \fIpackage\fR. Auto-loaded files are not +included in this list, only files which were directly sourced during package +initialization. The list order corresponds with the order in which the +files were sourced. +.TP \fBpackage forget\fR ?\fIpackage package ...\fR? . Removes all information about each specified package from this interpreter, diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index ed3d9a5..7f2a2f3 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -989,8 +989,11 @@ TclNRSourceObjCmd( { const char *encodingName = NULL; Tcl_Obj *fileName; + int result; + void **pkgFiles = NULL; + void *names = NULL; - if (objc != 2 && objc !=4) { + if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-encoding name? fileName"); return TCL_ERROR; } @@ -1008,8 +1011,28 @@ TclNRSourceObjCmd( return TCL_ERROR; } encodingName = TclGetString(objv[2]); + } else if (objc == 3) { + static const char *const nopkgoptions[] = { + "-nopkg", NULL + }; + int index; + + if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], nopkgoptions, + "option", TCL_EXACT, &index)) { + return TCL_ERROR; + } + pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL); + /* Make sure that during the following TclNREvalFile no filenames + * are recorded for inclusion in the "package files" command */ + names = *pkgFiles; + *pkgFiles = NULL; } - return TclNREvalFile(interp, fileName, encodingName); + result = TclNREvalFile(interp, fileName, encodingName); + if (pkgFiles) { + /* restore "tclPkgFiles" assocdata to how it was. */ + *pkgFiles = names; + } + return result; } /* diff --git a/generic/tclInt.h b/generic/tclInt.h index bfcd002..9422a03 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3101,6 +3101,7 @@ MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); MODULE_SCOPE void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName); +MODULE_SCOPE void *TclInitPkgFiles(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_PathPart portion); MODULE_SCOPE char * TclpReadlink(const char *fileName, diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 1bfe76a..7874de9 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -331,13 +331,24 @@ TclSetPreInitScript( *---------------------------------------------------------------------- */ +typedef struct PkgName { + struct PkgName *nextPtr; /* Next in list of package names being initialized. */ + char name[4]; +} PkgName; + int Tcl_Init( Tcl_Interp *interp) /* Interpreter to initialize. */ { + PkgName pkgName = {NULL, "Tcl"}; + PkgName **names = TclInitPkgFiles(interp); + int result = TCL_ERROR; + + pkgName.nextPtr = *names; + *names = &pkgName; if (tclPreInitScript != NULL) { if (Tcl_EvalEx(interp, tclPreInitScript, -1, 0) == TCL_ERROR) { - return TCL_ERROR; + goto end; } } @@ -382,7 +393,7 @@ Tcl_Init( * alternate tclInit command before calling Tcl_Init(). */ - return Tcl_EvalEx(interp, + result = Tcl_EvalEx(interp, "if {[namespace which -command tclInit] eq \"\"} {\n" " proc tclInit {} {\n" " global tcl_libPath tcl_library env tclDefaultLibrary\n" @@ -445,6 +456,10 @@ Tcl_Init( " }\n" "}\n" "tclInit", -1, 0); + +end: + *names = (*names)->nextPtr; + return result; } /* diff --git a/generic/tclPkg.c b/generic/tclPkg.c index c258987..c3cc54e 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -38,7 +38,7 @@ typedef struct PkgName { } PkgName; typedef struct PkgFiles { - PkgName *names; /* Package names being initialized. */ + PkgName *names; /* Package names being initialized. Must be first field*/ Tcl_HashTable table; /* Table which contains files for each package */ } PkgFiles; @@ -222,6 +222,19 @@ static void PkgFilesCleanupProc(ClientData clientData, return; } +void *TclInitPkgFiles(Tcl_Interp *interp) +{ + /* If assocdata "tclPkgFiles" doesn't exist yet, create it */ + PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL); + if (!pkgFiles) { + pkgFiles = ckalloc(sizeof(PkgFiles)); + pkgFiles->names = NULL; + Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS); + Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles); + } + return pkgFiles; +} + void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName) { PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL); @@ -549,14 +562,7 @@ PkgRequireCore( pkgPtr->clientData = versionToProvide; Tcl_Preserve(versionToProvide); Tcl_Preserve(script); - /* If assocdata "tclPkgFiles" doesn't exist yet, create it */ - pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL); - if (!pkgFiles) { - pkgFiles = ckalloc(sizeof(PkgFiles)); - pkgFiles->names = NULL; - Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS); - Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles); - } + pkgFiles = TclInitPkgFiles(interp); /* Push "ifneeded" package name in "tclPkgFiles" assocdata. */ pkgName = ckalloc(sizeof(PkgName) + strlen(name)); pkgName->nextPtr = pkgFiles->names; diff --git a/library/init.tcl b/library/init.tcl index 544ea77..bac6270 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -483,7 +483,7 @@ proc auto_load_index {} { set dir [lindex $auto_path $i] set f "" if {$issafe} { - catch {source [file join $dir tclIndex]} + catch {source -nopkg [file join $dir tclIndex]} } elseif {[catch {set f [open [file join $dir tclIndex]]}]} { continue } else { diff --git a/library/package.tcl b/library/package.tcl index 44e3b28..cb1bea6 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -488,7 +488,7 @@ proc tclPkgUnknown {name args} { set dir [file dirname $file] if {![info exists procdDirs($dir)]} { try { - source $file + source -nopkg $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue diff --git a/library/tclIndex b/library/tclIndex index 26603c1..2762ce4 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -1,75 +1,75 @@ # Tcl autoload index file, version 2.0 # -*- tcl -*- # This file is generated by the "auto_mkindex" command -# and sourced to set up indexing information for one or +# and source -nopkgd to set up indexing information for one or # more commands. Typically each line is a command that # sets an element in the auto_index array, where the # element name is the name of a command and the value is # a script that loads the command. -set auto_index(auto_reset) [list source [file join $dir auto.tcl]] -set auto_index(tcl_findLibrary) [list source [file join $dir auto.tcl]] -set auto_index(auto_mkindex) [list source [file join $dir auto.tcl]] -set auto_index(auto_mkindex_old) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::init) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::cleanup) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::mkindex) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::hook) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::slavehook) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::command) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::commandInit) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::fullname) [list source [file join $dir auto.tcl]] -set auto_index(history) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistClear) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistInfo) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]] -set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]] -set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]] -set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]] -set auto_index(::tcl::MacOSXPkgUnknown) [list source [file join $dir package.tcl]] -set auto_index(::pkg::create) [list source [file join $dir package.tcl]] -set auto_index(parray) [list source [file join $dir parray.tcl]] -set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]] -set auto_index(::safe::CheckInterp) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpCreate) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpSetConfig) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpInit) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]] -set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]] -set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]] -set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::Log) [list source [file join $dir safe.tcl]] -set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasGlob) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]] -set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::DirInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasEncoding) [list source [file join $dir safe.tcl]] -set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]] -set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]] -set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]] -set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]] -set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]] -set auto_index(::tcl::tm::add) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::remove) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::list) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::Defaults) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::UnknownHandler) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::roots) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::path) [list source [file join $dir tm.tcl]] +set auto_index(auto_reset) [list source -nopkg [file join $dir auto.tcl]] +set auto_index(tcl_findLibrary) [list source -nopkg [file join $dir auto.tcl]] +set auto_index(auto_mkindex) [list source -nopkg [file join $dir auto.tcl]] +set auto_index(auto_mkindex_old) [list source -nopkg [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::init) [list source -nopkg [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::cleanup) [list source -nopkg [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::mkindex) [list source -nopkg [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::hook) [list source -nopkg [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::slavehook) [list source -nopkg [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::command) [list source -nopkg [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::commandInit) [list source -nopkg [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::fullname) [list source -nopkg [file join $dir auto.tcl]] +set auto_index(history) [list source -nopkg [file join $dir history.tcl]] +set auto_index(::tcl::HistAdd) [list source -nopkg [file join $dir history.tcl]] +set auto_index(::tcl::HistKeep) [list source -nopkg [file join $dir history.tcl]] +set auto_index(::tcl::HistClear) [list source -nopkg [file join $dir history.tcl]] +set auto_index(::tcl::HistInfo) [list source -nopkg [file join $dir history.tcl]] +set auto_index(::tcl::HistRedo) [list source -nopkg [file join $dir history.tcl]] +set auto_index(::tcl::HistIndex) [list source -nopkg [file join $dir history.tcl]] +set auto_index(::tcl::HistEvent) [list source -nopkg [file join $dir history.tcl]] +set auto_index(::tcl::HistChange) [list source -nopkg [file join $dir history.tcl]] +set auto_index(pkg_mkIndex) [list source -nopkg [file join $dir package.tcl]] +set auto_index(tclPkgSetup) [list source -nopkg [file join $dir package.tcl]] +set auto_index(tclPkgUnknown) [list source -nopkg [file join $dir package.tcl]] +set auto_index(::tcl::MacOSXPkgUnknown) [list source -nopkg [file join $dir package.tcl]] +set auto_index(::pkg::create) [list source -nopkg [file join $dir package.tcl]] +set auto_index(parray) [list source -nopkg [file join $dir parray.tcl]] +set auto_index(::safe::InterpStatics) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::InterpNested) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::interpCreate) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::interpInit) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::CheckInterp) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::interpConfigure) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::InterpCreate) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::InterpSetConfig) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::interpFindInAccessPath) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::interpAddToAccessPath) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::InterpInit) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::AddSubDirs) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::interpDelete) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::setLogCmd) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::SyncAccessPath) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::PathToken) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::TranslatePath) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::Log) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::CheckFileName) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::AliasGlob) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::AliasSource) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::AliasLoad) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::FileInAccessPath) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::DirInAccessPath) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::Subset) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::AliasSubset) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(::safe::AliasEncoding) [list source -nopkg [file join $dir safe.tcl]] +set auto_index(tcl_wordBreakAfter) [list source -nopkg [file join $dir word.tcl]] +set auto_index(tcl_wordBreakBefore) [list source -nopkg [file join $dir word.tcl]] +set auto_index(tcl_endOfWord) [list source -nopkg [file join $dir word.tcl]] +set auto_index(tcl_startOfNextWord) [list source -nopkg [file join $dir word.tcl]] +set auto_index(tcl_startOfPreviousWord) [list source -nopkg [file join $dir word.tcl]] +set auto_index(::tcl::tm::add) [list source -nopkg [file join $dir tm.tcl]] +set auto_index(::tcl::tm::remove) [list source -nopkg [file join $dir tm.tcl]] +set auto_index(::tcl::tm::list) [list source -nopkg [file join $dir tm.tcl]] +set auto_index(::tcl::tm::Defaults) [list source -nopkg [file join $dir tm.tcl]] +set auto_index(::tcl::tm::UnknownHandler) [list source -nopkg [file join $dir tm.tcl]] +set auto_index(::tcl::tm::roots) [list source -nopkg [file join $dir tm.tcl]] +set auto_index(::tcl::tm::path) [list source -nopkg [file join $dir tm.tcl]] diff --git a/tests/package.test b/tests/package.test index 7e8a42d..55bba8a 100644 --- a/tests/package.test +++ b/tests/package.test @@ -877,7 +877,7 @@ test package-5.3 {package files} -body { } foo eval package require t 2.4 foo eval {list [package files http] [package files t]} -} -result "[list {}] [file join $tcl_library http http.tcl]" +} -result {{} {}} test package-6.1 {CheckVersion procedure} { package vcompare 1 2.1 -- cgit v0.12