From 04ed8b5460eeb335eba5d6c092bd8d5420664bed Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 28 Jul 2004 18:00:08 +0000 Subject: * library/package.tcl: Moved private command * library/tclIndex: [pkg_compareExtension] into ::tcl::Pkg. * tests/pkg_mkIndex.test: Also moved implementation of [::pkg::create] to [::tcl::Pkg::Create]. --- ChangeLog | 7 +++++++ library/package.tcl | 31 +++++++++++++++++++------------ library/tclIndex | 1 - tests/pkgMkIndex.test | 28 ++++++++++++++-------------- 4 files changed, 40 insertions(+), 27 deletions(-) diff --git a/ChangeLog b/ChangeLog index af69981..3a6f47f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2004-07-28 Don Porter + + * library/package.tcl: Moved private command + * library/tclIndex: [pkg_compareExtension] into ::tcl::Pkg. + * tests/pkg_mkIndex.test: Also moved implementation of + [::pkg::create] to [::tcl::Pkg::Create]. + 2004-07-25 Pat Thoyts * tests/io.test: Make io-61.1 create file as binary to pass on Win32 diff --git a/library/package.tcl b/library/package.tcl index 9eb155e..a5b1407 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.28 2004/03/17 18:14:14 das Exp $ +# RCS: @(#) $Id: package.tcl,v 1.29 2004/07/28 18:00:10 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. @@ -12,11 +12,9 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# Create the package namespace -namespace eval ::pkg { -} +namespace eval tcl::Pkg {} -# pkg_compareExtension -- +# ::tcl::Pkg::CompareExtension -- # # Used internally by pkg_mkIndex to compare the extension of a file to # a given extension. On Windows, it uses a case-insensitive comparison @@ -31,7 +29,7 @@ namespace eval ::pkg { # Results: # Returns 1 if the extension matches, 0 otherwise -proc pkg_compareExtension { fileName {ext {}} } { +proc tcl::Pkg::CompareExtension { fileName {ext {}} } { global tcl_platform if {![string length $ext]} {set ext [info sharedlibextension]} if {[string equal $tcl_platform(platform) "windows"]} { @@ -246,7 +244,8 @@ proc pkg_mkIndex {args} { # just deleted the unknown procedure. This doesn't handle # procedures with default arguments. - foreach p {pkg_compareExtension} { + foreach p {::tcl::Pkg::CompareExtension} { + $c eval [list namespace eval [namespace qualifiers $p] {}] $c eval [list proc $p [info args $p] [info body $p]] } @@ -284,7 +283,7 @@ proc pkg_mkIndex {args} { # on some systems (like SunOS) the loader will abort the # whole application when it gets an error. - if {[pkg_compareExtension $::tcl::file [info sharedlibextension]]} { + if {[::tcl::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 @@ -403,7 +402,7 @@ proc pkg_mkIndex {args} { foreach {name version} $pkg { break } - lappend cmd ::pkg::create -name $name -version $version + lappend cmd ::tcl::Pkg::Create -name $name -version $version foreach spec $files($pkg) { foreach {file type procs} $spec { if { $direct } { @@ -635,13 +634,13 @@ proc tcl::MacOSXPkgUnknown {original name version {exact {}}} { } } -# ::pkg::create -- +# ::tcl::Pkg::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: +# args arguments used by the Create function: # -name packageName # -version packageVersion # -load {filename ?{procs}?} @@ -661,7 +660,7 @@ proc tcl::MacOSXPkgUnknown {original name version {exact {}}} { # Results: # An appropriate "package ifneeded" statement for the package. -proc ::pkg::create {args} { +proc ::tcl::Pkg::Create {args} { append err(usage) "[lindex [info level 0] 0] " append err(usage) "-name packageName -version packageVersion" append err(usage) "?-load {filename ?{procs}?}? ... " @@ -754,3 +753,11 @@ proc ::pkg::create {args} { return $cmdline } +# Change this to +# interp alias {} ::pkg::create {} ::tcl::Pkg::Create +# as soon as safe-2.1 accepts it. +namespace eval pkg { + proc create args { + uplevel 1 ::tcl::Pkg::Create $args + } +} diff --git a/library/tclIndex b/library/tclIndex index 65d37a6..5d963a0 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -28,7 +28,6 @@ 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(tclLdAout) [list source [file join $dir ldAout.tcl]] -set auto_index(pkg_compareExtension) [list source [file join $dir package.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]] diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index b3e5249..b7bd664 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.26 2004/06/23 15:36:57 dkf Exp $ +# RCS: @(#) $Id: pkgMkIndex.test,v 1.27 2004/07/28 18:00:11 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -673,24 +673,24 @@ test pkgMkIndex-13.1 {proc names with embedded spaces} { removeFile [file join pkg spacename.tcl] -# Test the pkg_compareExtension helper function -test pkgMkIndex-14.1 {pkg_compareExtension} {unix} { - pkg_compareExtension foo.so .so +# Test the tcl::Pkg::CompareExtension helper function +test pkgMkIndex-14.1 {tcl::Pkg::CompareExtension} {unix} { + tcl::Pkg::CompareExtension foo.so .so } 1 -test pkgMkIndex-14.2 {pkg_compareExtension} {unix} { - pkg_compareExtension foo.so.bar .so +test pkgMkIndex-14.2 {tcl::Pkg::CompareExtension} {unix} { + tcl::Pkg::CompareExtension foo.so.bar .so } 0 -test pkgMkIndex-14.3 {pkg_compareExtension} {unix} { - pkg_compareExtension foo.so.1 .so +test pkgMkIndex-14.3 {tcl::Pkg::CompareExtension} {unix} { + tcl::Pkg::CompareExtension foo.so.1 .so } 1 -test pkgMkIndex-14.4 {pkg_compareExtension} {unix} { - pkg_compareExtension foo.so.1.2 .so +test pkgMkIndex-14.4 {tcl::Pkg::CompareExtension} {unix} { + tcl::Pkg::CompareExtension foo.so.1.2 .so } 1 -test pkgMkIndex-14.5 {pkg_compareExtension} {unix} { - pkg_compareExtension foo .so +test pkgMkIndex-14.5 {tcl::Pkg::CompareExtension} {unix} { + tcl::Pkg::CompareExtension foo .so } 0 -test pkgMkIndex-14.6 {pkg_compareExtension} {unix} { - pkg_compareExtension foo.so.1.2.bar .so +test pkgMkIndex-14.6 {tcl::Pkg::CompareExtension} {unix} { + tcl::Pkg::CompareExtension foo.so.1.2.bar .so } 0 # cleanup -- cgit v0.12