summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorericm <ericm>2000-02-01 01:14:00 (GMT)
committerericm <ericm>2000-02-01 01:14:00 (GMT)
commitacb2f260bec04797bce0d16b709b530c511fe87f (patch)
tree112da6d0b67c743bbc7eec435cfb6c42345bd653
parentbfc121a8bd79c18c8d1b7760be65a4db3ad18bfd (diff)
downloadtcl-acb2f260bec04797bce0d16b709b530c511fe87f.zip
tcl-acb2f260bec04797bce0d16b709b530c511fe87f.tar.gz
tcl-acb2f260bec04797bce0d16b709b530c511fe87f.tar.bz2
* tests/package.test:
* library/tclIndex: * library/package.tcl: Added ::package namespace and ::package::create function. * library/init.tcl: Fixed problem with auto_load and determining if commands were loaded. * library/auto.tcl: "Fixed" issues with $ in files to be auto indexed. * doc/Package.n: New man page for package::create function. * doc/pkgMkIndex.n: Added additional information. * doc/library.n: Added additional qualification regarding auto_mkindex.
-rw-r--r--doc/Package.n57
-rw-r--r--doc/library.n7
-rw-r--r--doc/pkgMkIndex.n6
-rw-r--r--library/auto.tcl24
-rw-r--r--library/init.tcl10
-rw-r--r--library/package.tcl170
-rw-r--r--library/tclIndex1
-rw-r--r--tests/package.test71
8 files changed, 304 insertions, 42 deletions
diff --git a/doc/Package.n b/doc/Package.n
new file mode 100644
index 0000000..4859c2f
--- /dev/null
+++ b/doc/Package.n
@@ -0,0 +1,57 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id: Package.n,v 1.1 2000/02/01 01:14:00 ericm Exp $
+'\"
+.so man.macros
+.TH package::create n 8.3 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+package::create \- Construct an appropriate \fBpackage ifneeded\fR
+command for a given package specification
+.SH SYNOPSIS
+.nf
+.VS 8.3.0
+\fB::package::create \fI-name packageName\fR \fI-version
+packageVersion\fR ?\fI-load filespec\fR? ... ?\fI-source filespec\fR? ...
+
+.SH DESCRIPTION
+.PP
+\fB::package::create\fR is a utility procedure that is part of the standard
+Tcl library. It is used to create an appropriate \fBpackage
+ifneeded\fR command for a given package specification. It can be used
+to construct a \fBpkgIndex.tcl\fR file for use with the \fBpackage\fI
+mechanism.
+
+.SH OPTIONS
+The parameters supported are:
+.TP
+\fB\-name\fR\0\fIpackageName\fR
+This parameter specifies the name of the package. It is required.
+.TP
+\fB\-version\fR\0\fIpackageVersion\fR
+This parameter specifies the version of the package. It is required.
+.TP
+\fB\-load\fR\0\fIfilespec\fR
+This parameter specifies a binary library that must be loaded with the
+\fBload\fR command. \fIfilespec\fR is a list with two elements. The
+first element is the name of the file to load. The second, optional
+element is a list of commands supplied by loading that file. If the
+list of procedures is empty or omitted, \fB::package::create\fR will
+set up the library for direct loading (see \fBpkg_mkIndex\fR). Any
+number of \fB-load\fR parameters may be specified.
+.TP
+\fB\-source\fR\0\fIfilespec\fR
+This parameter is similar to the \fB-load\fR parameter, except that it
+specifies a Tcl library that must be loaded with the
+\fBsource\fR command. Any number of \fB-source\fR parameters may be
+specified.
+.PP
+At least one \fB-load\fR or \fB-source\fR paramter must be given.
+
+
+
+.SH KEYWORDS
+auto-load, index, package, version
diff --git a/doc/library.n b/doc/library.n
index e958e63..1b1ee6d 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.8 1999/06/29 00:25:23 welch Exp $
+'\" RCS: @(#) $Id: library.n,v 1.9 2000/02/01 01:14:01 ericm Exp $
.so man.macros
.TH library n "8.0" Tcl "Tcl Built-In Commands"
.BS
@@ -139,7 +139,10 @@ as its first characters then it is assumed to be a procedure
definition and the next word of the line is taken as the
procedure's name.
Procedure definitions that don't appear in this way (e.g. they
-have spaces before the \fBproc\fR) will not be indexed.
+have spaces before the \fBproc\fR) will not be indexed. If your
+script contains "dangerous" code, such as global initialization
+code or procedure names with special characters like \fB$\fR,
+\fB*\fR, \fB[\fR or \fB]\fR, you are safer using auto_mkindex_old.
.RE
.TP
\fBauto_reset\fR
diff --git a/doc/pkgMkIndex.n b/doc/pkgMkIndex.n
index cb77b8b..f816436 100644
--- a/doc/pkgMkIndex.n
+++ b/doc/pkgMkIndex.n
@@ -4,17 +4,17 @@
'\" 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.7 2000/01/27 19:20:05 ericm Exp $
+'\" RCS: @(#) $Id: pkgMkIndex.n,v 1.8 2000/02/01 01:14:01 ericm Exp $
'\"
.so man.macros
-.TH pkg_mkIndex n 8.0 Tcl "Tcl Built-In Commands"
+.TH pkg_mkIndex n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
pkg_mkIndex \- Build an index for automatic loading of packages
.SH SYNOPSIS
.nf
-.VS 8.0.3
+.VS 8.3.0
\fBpkg_mkIndex ?\fI-lazy\fR? ?\fI-load pkgPat\fR? ?\fI-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
.VE
.fi
diff --git a/library/auto.tcl b/library/auto.tcl
index 07b3116..9575f7b 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -3,7 +3,7 @@
# utility procs formerly in init.tcl dealing with auto execution
# of commands and can be auto loaded themselves.
#
-# RCS: @(#) $Id: auto.tcl,v 1.5 2000/01/28 16:38:34 ericm Exp $
+# RCS: @(#) $Id: auto.tcl,v 1.6 2000/02/01 01:14:01 ericm Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -318,13 +318,13 @@ proc auto_mkindex_parser::mkindex {file} {
# There is one problem with sourcing files into the safe
# interpreter: references like "$x" will fail since code is not
# really being executed and variables do not really exist.
- # Be careful to escape all naked "$" before evaluating.
- regsub -expanded -all {
- ([^\\](?:(?:\\\\)*)) # match any even number of backslashes ...
- \$ # ... followed by an unescaped dollar sign ...
- ([^\$]) # ... followed by anything but another dollar sign
- } $contents {\1\\$\2} contents; # add one backslash for the dollar sign
-
+ # To avoid this, we replace all $ with \0 (literally, the null char)
+ # later, when getting proc names we will have to reverse this replacement,
+ # in case there were any $ in the proc name. This will cause a problem
+ # if somebody actually tries to have a \0 in their proc name. Too bad
+ # for them.
+ regsub -all {\$} $contents "\0" contents
+
set index ""
set contextStack ""
set imports ""
@@ -466,10 +466,14 @@ proc auto_mkindex_parser::fullname {name} {
}
if {[string equal [namespace qualifiers $name] ""]} {
- return [namespace tail $name]
+ set name [namespace tail $name]
} elseif {![string match ::* $name]} {
- return "::$name"
+ set name "::$name"
}
+
+ # Earlier, mkindex replaced all $'s with \0. Now, we have to reverse
+ # that replacement.
+ regsub -all "\0" $name "\$" name
return $name
}
diff --git a/library/init.tcl b/library/init.tcl
index c5fff21..ecc926f 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.37 2000/01/29 00:12:46 ericm Exp $
+# RCS: @(#) $Id: init.tcl,v 1.38 2000/02/01 01:14:01 ericm Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -312,10 +312,10 @@ proc auto_load {cmd {namespace {}}} {
# name. One is to use
# info commands $name
# Unfortunately, if the name has glob-magic chars in it like *
- # or [], it may not match. Since we really want an exact match,
- # a better route is to use
- # lsearch -exact [info commands] $name
- if {[lsearch -exact [info commands] $name] != -1 } {
+ # or [], it may not match. For our purposes here, a better
+ # route is to use
+ # namespace which -command $name
+ if { ![string equal [namespace which -command $name] ""] } {
return 1
}
}
diff --git a/library/package.tcl b/library/package.tcl
index c9506a8..c1f8415 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.9 2000/01/28 19:32:05 ericm Exp $
+# RCS: @(#) $Id: package.tcl,v 1.10 2000/02/01 01:14:01 ericm Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -12,6 +12,10 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
+# Create the package namespace
+namespace eval ::package {
+}
+
# pkg_compareExtension --
#
# Used internally by pkg_mkIndex to compare the extension of a file to
@@ -116,15 +120,6 @@ proc pkg_mkIndex {args} {
set patternList [list "*.tcl" "*[info sharedlibextension]"]
}
- append index "# Tcl package index file, version 1.1\n"
- append index "# This file is generated by the \"pkg_mkIndex$more\" command\n"
- append index "# and sourced either when an application starts up or\n"
- append index "# by a \"package unknown\" script. It invokes the\n"
- append index "# \"package ifneeded\" command to set up package-related\n"
- 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"
set oldDir [pwd]
cd $dir
@@ -350,22 +345,33 @@ proc pkg_mkIndex {args} {
}
}
+ append index "# Tcl package index file, version 1.1\n"
+ append index "# This file is generated by the \"pkg_mkIndex$more\" command\n"
+ append index "# and sourced either when an application starts up or\n"
+ append index "# by a \"package unknown\" script. It invokes the\n"
+ append index "# \"package ifneeded\" command to set up package-related\n"
+ 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]] {
- append index "\npackage ifneeded $pkg "
- if {$direct} {
- set cmdList {}
- foreach elem $files($pkg) {
- set file [lindex $elem 0]
- set type [lindex $elem 1]
- lappend cmdList "\[list $type \[file join \$dir\
- [list $file]\]\]"
+ set cmd {}
+ foreach {name version} $pkg {
+ break
+ }
+ lappend cmd ::package::create -name $name -version $version
+ foreach spec $files($pkg) {
+ foreach {file type procs} $spec {
+ if { $direct } {
+ set procs {}
+ }
+ lappend cmd "-$type" [list $file $procs]
}
- append index [join $cmdList "\\n"]
- } else {
- append index "\[list tclPkgSetup \$dir [lrange $pkg 0 0]\
- [lrange $pkg 1 1] [list $files($pkg)]\]"
}
+ append index "\n[eval $cmd]"
}
+
set f [open pkgIndex.tcl w]
puts $f $index
close $f
@@ -481,3 +487,123 @@ proc tclPkgUnknown {name version {exact {}}} {
}
}
}
+
+# ::package::create --
+#
+# Given a package specification generate a "package ifneeded" statement
+# for the package, suitable for inclusion in a pkgIndex.tcl file.
+#
+# Arguments:
+# args arguments used by the create function:
+# -name packageName
+# -version packageVersion
+# -load {filename ?{procs}?}
+# ...
+# -source {filename ?{procs}?}
+# ...
+#
+# Any number of -load and -source parameters may be
+# specified, so long as there is at least one -load or
+# -source parameter. If the procs component of a
+# module specifier is left off, that module will be
+# set up for direct loading; otherwise, it will be
+# set up for lazy loading. If both -source and -load
+# are specified, the -load'ed files will be loaded
+# first, followed by the -source'd files.
+#
+# Results:
+# An appropriate "package ifneeded" statement for the package.
+
+proc ::package::create {args} {
+ append err(usage) "::package::create "
+ append err(usage) "-name packageName -version packageVersion"
+ append err(usage) "?-load {filename ?{procs}?}? ... "
+ append err(usage) "?-source {filename ?{procs}?}? ..."
+
+ set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""
+ set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""
+ set err(unknownOpt) "unknown option \"%s\": should be \"$err(usage)\""
+ set err(noLoadOrSource) "at least one of -load and -source must be given"
+
+ # process arguments
+ set len [llength $args]
+ if { $len < 6 } {
+ error $err(wrongNumArgs)
+ }
+
+ # Initialize parameters
+ set opts(-name) {}
+ set opts(-version) {}
+ set opts(-source) {}
+ set opts(-load) {}
+
+ # process parameters
+ for {set i 0} {$i < $len} {incr i} {
+ set flag [lindex $args $i]
+ incr i
+ switch -glob -- $flag {
+ "-name" -
+ "-version" {
+ if { $i >= $len } {
+ error [format $err(valueMissing) $flag]
+ }
+ set opts($flag) [lindex $args $i]
+ }
+ "-source" -
+ "-load" {
+ if { $i >= $len } {
+ error [format $err(valueMissing) $flag]
+ }
+ lappend opts($flag) [lindex $args $i]
+ }
+ default {
+ error [format $err(unknownOpt) [lindex $args $i]]
+ }
+ }
+ }
+
+ # Validate the parameters
+ if { [llength $opts(-name)] == 0 } {
+ error [format $err(valueMissing) "-name"]
+ }
+ if { [llength $opts(-version)] == 0 } {
+ error [format $err(valueMissing) "-version"]
+ }
+
+ if { [llength $opts(-source)] == 0 && [llength $opts(-load)] == 0 } {
+ error $err(noLoadOrSource)
+ }
+
+ # OK, now everything is good. Generate the package ifneeded statment.
+ set cmdline "package ifneeded $opts(-name) $opts(-version) "
+
+ set cmdList {}
+ set lazyFileList {}
+
+ # Handle -load and -source specs
+ foreach key {load source} {
+ foreach filespec $opts(-$key) {
+ foreach {filename proclist} {{} {}} {
+ break
+ }
+ foreach {filename proclist} $filespec {
+ break
+ }
+
+ if { [llength $proclist] == 0 } {
+ set cmd "\[list $key \[file join \$dir [list $filename]\]\]"
+ lappend cmdList $cmd
+ } else {
+ lappend lazyFileList [list $filename $key $proclist]
+ }
+ }
+ }
+
+ if { [llength $lazyFileList] > 0 } {
+ lappend cmdList "\[list tclPkgSetup \$dir $opts(-name)\
+ $opts(-version) [list $lazyFileList]\]"
+ }
+ append cmdline [join $cmdList "\\n"]
+ return $cmdline
+}
+
diff --git a/library/tclIndex b/library/tclIndex
index 35c7cf6..92500b2 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -33,6 +33,7 @@ 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(tclMacPkgSearch) [list source [file join $dir package.tcl]]
set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]]
+set auto_index(::package::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]]
diff --git a/tests/package.test b/tests/package.test
new file mode 100644
index 0000000..0262e31
--- /dev/null
+++ b/tests/package.test
@@ -0,0 +1,71 @@
+# This file contains tests for the ::package::* commands.
+# 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.
+#
+# RCS: @(#) $Id: package.test,v 1.1 2000/02/01 01:14:02 ericm Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import ::tcltest::*
+}
+
+test package-1.1 {package::create gives error on insufficient args} {
+ catch {::package::create}
+} 1
+test package-1.2 {package::create gives error on bad args} {
+ catch {::package::create -foo bar -bar baz -baz boo}
+} 1
+test package-1.3 {package::create gives error on no value given} {
+ catch {::package::create -name foo -version 1.0 -source test.tcl -load}
+} 1
+test package-1.4 {package::create gives error on no name given} {
+ catch {::package::create -version 1.0 -source test.tcl -load foo.so}
+} 1
+test package-1.5 {package::create gives error on no version given} {
+ catch {::package::create -name foo -source test.tcl -load foo.so}
+} 1
+test package-1.6 {package::create gives error on no source or load options} {
+ catch {::package::create -name foo -version 1.0 -version 2.0}
+} 1
+test package-1.7 {package::create gives correct output for 1 direct source} {
+ ::package::create -name foo -version 1.0 -source test.tcl
+} {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]}
+test package-1.8 {package::create gives correct output for 2 direct sources} {
+ ::package::create -name foo -version 1.0 -source test.tcl -source test2.tcl
+} {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]\n[list source [file join $dir test2.tcl]]}
+test package-1.9 {package::create gives correct output for 1 direct load} {
+ ::package::create -name foo -version 1.0 -load test.so
+} {package ifneeded foo 1.0 [list load [file join $dir test.so]]}
+test package-1.10 {package::create gives correct output for 2 direct loads} {
+ ::package::create -name foo -version 1.0 -load test.so -load test2.so
+} {package ifneeded foo 1.0 [list load [file join $dir test.so]]\n[list load [file join $dir test2.so]]}
+test package-1.11 {package::create gives correct output for 1 lazy source} {
+ ::package::create -name foo -version 1.0 -source {test.tcl {foo bar}}
+} {package ifneeded foo 1.0 [list tclPkgSetup $dir foo 1.0 {{test.tcl source {foo bar}}}]}
+test package-1.12 {package::create gives correct output for 2 lazy sources} {
+ ::package::create -name foo -version 1.0 -source {test.tcl {foo bar}} \
+ -source {test2.tcl {baz boo}}
+} {package ifneeded foo 1.0 [list tclPkgSetup $dir foo 1.0 {{test.tcl source {foo bar}} {test2.tcl source {baz boo}}}]}
+test package-1.13 {package::create gives correct output for 1 lazy load} {
+ ::package::create -name foo -version 1.0 -load {test.so {foo bar}}
+} {package ifneeded foo 1.0 [list tclPkgSetup $dir foo 1.0 {{test.so load {foo bar}}}]}
+test package-1.14 {package::create gives correct output for 2 lazy loads} {
+ ::package::create -name foo -version 1.0 -load {test.so {foo bar}} \
+ -load {test2.so {baz boo}}
+} {package ifneeded foo 1.0 [list tclPkgSetup $dir foo 1.0 {{test.so load {foo bar}} {test2.so load {baz boo}}}]}
+test package-1.15 {package::create gives correct output for 1 each, direct} {
+ ::package::create -name foo -version 1.0 -source test.tcl -load test2.so
+} {package ifneeded foo 1.0 [list load [file join $dir test2.so]]\n[list source [file join $dir test.tcl]]}
+test package-1.16 {package::create gives correct output for 1 direct, 1 lazy} {
+ ::package::create -name foo -version 1.0 -source test.tcl \
+ -source {test2.tcl {foo bar}}
+} {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]\n[list tclPkgSetup $dir foo 1.0 {{test2.tcl source {foo bar}}}]}
+
+::tcltest::cleanupTests
+return