diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | library/package.tcl | 29 | ||||
| -rw-r--r-- | tests/pkgMkIndex.test | 22 |
3 files changed, 51 insertions, 7 deletions
@@ -1,5 +1,12 @@ 2000-07-19 Eric Melski <ericm@ajubasolutions.com> + * tests/pkgMkIndex.test: Added tests for pkg_compareExtension. + + * library/package.tcl: Enhanced pkg_compareExtension to handle + Unixes which tack the version number on to the end of library + names (eg, foo.so.1.2); such filenames will be correctly matched. + (Patch from Vince Darley). + * win/makefile.vc: Applied patch from Don Porter to provide better nmake support for NT/Alpha [RFE: 5938]. diff --git a/library/package.tcl b/library/package.tcl index c3f3572..09886f0 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.14 2000/04/23 03:36:51 jingham Exp $ +# RCS: @(#) $Id: package.tcl,v 1.15 2000/07/19 21:40:57 ericm Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. @@ -33,13 +33,30 @@ namespace eval ::pkg { proc pkg_compareExtension { fileName {ext {}} } { global tcl_platform - if {[string length $ext] == 0} { - set ext [info sharedlibextension] - } + if {![string length $ext]} {set ext [info sharedlibextension]} if {[string equal $tcl_platform(platform) "windows"]} { - return [string equal -nocase [file extension $fileName] $ext] + return [string equal -nocase [file extension $fileName] $ext] } else { - return [string equal [file extension $fileName] $ext] + # Some unices add trailing numbers after the .so, so + # we could have something like '.so.1.2'. + set root $fileName + while {1} { + set currExt [file extension $root] + if {[string equal $currExt $ext]} { + return 1 + } + + # The current extension does not match; if it is not a numeric + # value, quit, as we are only looking to ignore version number + # extensions. Otherwise we might return 1 in this case: + # pkg_compareExtension foo.so.bar .so + # which should not match. + + if { ![string is integer -strict [string range $currExt 1 end]] } { + return 0 + } + set root [file rootname $root] + } } } diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index 928d2e9..af0d5c6 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.16 2000/04/10 17:19:03 ericm Exp $ +# RCS: @(#) $Id: pkgMkIndex.test,v 1.17 2000/07/19 21:40:57 ericm Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -362,6 +362,26 @@ test pkgMkIndex-13.1 {proc names with embedded spaces} { pkgtest::runIndex -lazy $fullPkgPath spacename.tcl } {0 {{spacename:1.0 {tclPkgSetup {spacename.tcl source {{a b} {c d}}}}}}} +# Test the pkg_compareExtension helper function +test pkgMkIndex-14.1 {pkg_compareExtension} {unixOnly} { + pkg_compareExtension foo.so .so +} 1 +test pkgMkIndex-14.2 {pkg_compareExtension} {unixOnly} { + pkg_compareExtension foo.so.bar .so +} 0 +test pkgMkIndex-14.3 {pkg_compareExtension} {unixOnly} { + pkg_compareExtension foo.so.1 .so +} 1 +test pkgMkIndex-14.4 {pkg_compareExtension} {unixOnly} { + pkg_compareExtension foo.so.1.2 .so +} 1 +test pkgMkIndex-14.5 {pkg_compareExtension} {unixOnly} { + pkg_compareExtension foo .so +} 0 +test pkgMkIndex-14.6 {pkg_compareExtension} {unixOnly} { + pkg_compareExtension foo.so.1.2.bar .so +} 0 + # cleanup namespace delete pkgtest |