os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/pkgMkIndex.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/pkgMkIndex.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,703 @@
1.4 +# This file contains tests for the pkg_mkIndex command.
1.5 +# Note that the tests are limited to Tcl scripts only, there are no shared
1.6 +# libraries against which to test.
1.7 +#
1.8 +# Sourcing this file into Tcl runs the tests and generates output for
1.9 +# errors. No output means no errors were found.
1.10 +#
1.11 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.12 +# All rights reserved.
1.13 +#
1.14 +# RCS: @(#) $Id: pkgMkIndex.test,v 1.23.2.1 2003/07/24 08:23:39 rmax Exp $
1.15 +
1.16 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.17 + package require tcltest 2
1.18 + namespace import -force ::tcltest::*
1.19 +}
1.20 +
1.21 +set fullPkgPath [makeDirectory pkg]
1.22 +
1.23 +
1.24 +namespace eval pkgtest {
1.25 + # Namespace for procs we can discard
1.26 +}
1.27 +
1.28 +# pkgtest::parseArgs --
1.29 +#
1.30 +# Parse an argument list.
1.31 +#
1.32 +# Arguments:
1.33 +# <flags> (optional) arguments starting with a dash are collected
1.34 +# as options to pkg_mkIndex and passed to pkg_mkIndex.
1.35 +# dirPath the directory to index
1.36 +# pattern0 pattern to index
1.37 +# ... pattern to index
1.38 +# patternN pattern to index
1.39 +#
1.40 +# Results:
1.41 +# Returns a three element list:
1.42 +# 0: the options
1.43 +# 1: the directory to index
1.44 +# 2: the patterns list
1.45 +
1.46 +proc pkgtest::parseArgs { args } {
1.47 + set options ""
1.48 +
1.49 + set argc [llength $args]
1.50 + for {set iarg 0} {$iarg < $argc} {incr iarg} {
1.51 + set a [lindex $args $iarg]
1.52 + if {[regexp {^-} $a]} {
1.53 + lappend options $a
1.54 + if {[string compare -load $a] == 0} {
1.55 + incr iarg
1.56 + lappend options [lindex $args $iarg]
1.57 + }
1.58 + } else {
1.59 + break
1.60 + }
1.61 + }
1.62 +
1.63 + set dirPath [lindex $args $iarg]
1.64 + incr iarg
1.65 + set patternList [lrange $args $iarg end]
1.66 +
1.67 + return [list $options $dirPath $patternList]
1.68 +}
1.69 +
1.70 +# pkgtest::parseIndex --
1.71 +#
1.72 +# Loads a pkgIndex.tcl file, records all the calls to "package ifneeded".
1.73 +#
1.74 +# Arguments:
1.75 +# filePath path to the pkgIndex.tcl file.
1.76 +#
1.77 +# Results:
1.78 +# Returns a list, in "array set/get" format, where the keys are the package
1.79 +# name and version (in the form "$name:$version"), and the values the rest
1.80 +# of the command line.
1.81 +
1.82 +proc pkgtest::parseIndex { filePath } {
1.83 + # create a slave interpreter, where we override "package ifneeded"
1.84 +
1.85 + set slave [interp create]
1.86 + if {[catch {
1.87 + $slave eval {
1.88 + rename package package_original
1.89 + proc package { args } {
1.90 + if {[string compare [lindex $args 0] ifneeded] == 0} {
1.91 + set pkg [lindex $args 1]
1.92 + set ver [lindex $args 2]
1.93 + set ::PKGS($pkg:$ver) [lindex $args 3]
1.94 + } else {
1.95 + return [eval package_original $args]
1.96 + }
1.97 + }
1.98 + array set ::PKGS {}
1.99 + }
1.100 +
1.101 + set dir [file dirname $filePath]
1.102 + $slave eval {set curdir [pwd]}
1.103 + $slave eval [list cd $dir]
1.104 + $slave eval [list set dir $dir]
1.105 + $slave eval [list source [file tail $filePath]]
1.106 + $slave eval {cd $curdir}
1.107 +
1.108 + # Create the list in sorted order, so that we don't get spurious
1.109 + # errors because the order has changed.
1.110 +
1.111 + array set P {}
1.112 + foreach {k v} [$slave eval {array get ::PKGS}] {
1.113 + set P($k) $v
1.114 + }
1.115 +
1.116 + set PKGS ""
1.117 + foreach k [lsort [array names P]] {
1.118 + lappend PKGS $k $P($k)
1.119 + }
1.120 + } err]} {
1.121 + set ei $::errorInfo
1.122 + set ec $::errorCode
1.123 +
1.124 + catch {interp delete $slave}
1.125 +
1.126 + error $ei $ec
1.127 + }
1.128 +
1.129 + interp delete $slave
1.130 +
1.131 + return $PKGS
1.132 +}
1.133 +
1.134 +# pkgtest::createIndex --
1.135 +#
1.136 +# Runs pkg_mkIndex for the given directory and set of patterns.
1.137 +# This procedure deletes any pkgIndex.tcl file in the target directory,
1.138 +# then runs pkg_mkIndex.
1.139 +#
1.140 +# Arguments:
1.141 +# <flags> (optional) arguments starting with a dash are collected
1.142 +# as options to pkg_mkIndex and passed to pkg_mkIndex.
1.143 +# dirPath the directory to index
1.144 +# pattern0 pattern to index
1.145 +# ... pattern to index
1.146 +# patternN pattern to index
1.147 +#
1.148 +# Results:
1.149 +# Returns a two element list:
1.150 +# 0: 1 if the procedure encountered an error, 0 otherwise.
1.151 +# 1: the error result if element 0 was 1
1.152 +
1.153 +proc pkgtest::createIndex { args } {
1.154 + set parsed [eval parseArgs $args]
1.155 + set options [lindex $parsed 0]
1.156 + set dirPath [lindex $parsed 1]
1.157 + set patternList [lindex $parsed 2]
1.158 +
1.159 + file mkdir $dirPath
1.160 +
1.161 + if {[catch {
1.162 + file delete [file join $dirPath pkgIndex.tcl]
1.163 + eval pkg_mkIndex $options [list $dirPath] $patternList
1.164 + } err]} {
1.165 + return [list 1 $err]
1.166 + }
1.167 +
1.168 + return [list 0 {}]
1.169 +}
1.170 +
1.171 +# makePkgList --
1.172 +#
1.173 +# Takes the output of a pkgtest::parseIndex call, filters it and returns a
1.174 +# cleaned up list of packages and their actions.
1.175 +#
1.176 +# Arguments:
1.177 +# inList output from a pkgtest::parseIndex.
1.178 +#
1.179 +# Results:
1.180 +# Returns a list of two element lists:
1.181 +# 0: the name:version
1.182 +# 1: a list describing the package.
1.183 +# For tclPkgSetup packages it consists of:
1.184 +# 0: the keyword tclPkgSetup
1.185 +# 1: the first file to source, with its exported procedures
1.186 +# 2: the second file ...
1.187 +# N: the N-1st file ...
1.188 +
1.189 +proc makePkgList { inList } {
1.190 + set pkgList ""
1.191 +
1.192 + foreach {k v} $inList {
1.193 + switch [lindex $v 0] {
1.194 + tclPkgSetup {
1.195 + set l tclPkgSetup
1.196 + foreach s [lindex $v 4] {
1.197 + lappend l $s
1.198 + }
1.199 + }
1.200 +
1.201 + source {
1.202 + set l $v
1.203 + }
1.204 +
1.205 + default {
1.206 + error "can't handle $k $v"
1.207 + }
1.208 + }
1.209 +
1.210 + lappend pkgList [list $k $l]
1.211 + }
1.212 +
1.213 + return $pkgList
1.214 +}
1.215 +
1.216 +# pkgtest::runIndex --
1.217 +#
1.218 +# Runs pkg_mkIndex, parses the generated index file.
1.219 +#
1.220 +# Arguments:
1.221 +# <flags> (optional) arguments starting with a dash are collected
1.222 +# as options to pkg_mkIndex and passed to pkg_mkIndex.
1.223 +# dirPath the directory to index
1.224 +# pattern0 pattern to index
1.225 +# ... pattern to index
1.226 +# patternN pattern to index
1.227 +#
1.228 +# Results:
1.229 +# Returns a two element list:
1.230 +# 0: 1 if the procedure encountered an error, 0 otherwise.
1.231 +# 1: if no error, this is the parsed generated index file, in the format
1.232 +# returned by pkgtest::parseIndex.
1.233 +# If error, this is the error result.
1.234 +
1.235 +proc pkgtest::runCreatedIndex {rv args} {
1.236 + if {[lindex $rv 0] == 0} {
1.237 + set parsed [eval parseArgs $args]
1.238 + set dirPath [lindex $parsed 1]
1.239 + set idxFile [file join $dirPath pkgIndex.tcl]
1.240 +
1.241 + if {[catch {
1.242 + set result [list 0 [makePkgList [parseIndex $idxFile]]]
1.243 + } err]} {
1.244 + set result [list 1 $err]
1.245 + }
1.246 + file delete $idxFile
1.247 + } else {
1.248 + set result $rv
1.249 + }
1.250 +
1.251 + return $result
1.252 +}
1.253 +proc pkgtest::runIndex { args } {
1.254 + set rv [eval createIndex $args]
1.255 + return [eval [list runCreatedIndex $rv] $args]
1.256 +}
1.257 +
1.258 +# If there is no match to the patterns, make sure the directory hasn't
1.259 +# changed on us
1.260 +
1.261 +test pkgMkIndex-1.1 {nothing matches pattern - current dir is the same} {
1.262 + list [pkgtest::runIndex -lazy $fullPkgPath nomatch.tcl] [pwd]
1.263 +} [list {1 {no files matched glob pattern "nomatch.tcl"}} [pwd]]
1.264 +
1.265 +makeFile {
1.266 +# This is a simple package, just to check basic functionality.
1.267 +package provide simple 1.0
1.268 +namespace eval simple {
1.269 + namespace export lower upper
1.270 +}
1.271 +proc simple::lower { stg } {
1.272 + return [string tolower $stg]
1.273 +}
1.274 +proc simple::upper { stg } {
1.275 + return [string toupper $stg]
1.276 +}
1.277 +} [file join pkg simple.tcl]
1.278 +
1.279 +test pkgMkIndex-2.1 {simple package} {
1.280 + pkgtest::runIndex -lazy $fullPkgPath simple.tcl
1.281 +} {0 {{simple:1.0 {tclPkgSetup {simple.tcl source {::simple::lower ::simple::upper}}}}}}
1.282 +
1.283 +test pkgMkIndex-2.2 {simple package - use -direct} {
1.284 + pkgtest::runIndex -direct $fullPkgPath simple.tcl
1.285 +} "0 {{simple:1.0 {[list source [file join $fullPkgPath simple.tcl]]}}}"
1.286 +
1.287 +test pkgMkIndex-2.3 {simple package - direct loading is default} {
1.288 + pkgtest::runIndex $fullPkgPath simple.tcl
1.289 +} "0 {{simple:1.0 {[list source [file join $fullPkgPath simple.tcl]]}}}"
1.290 +
1.291 +test pkgMkIndex-2.4 {simple package - use -verbose} -body {
1.292 + pkgtest::runIndex -verbose $fullPkgPath simple.tcl
1.293 +} -result "0 {{simple:1.0 {[list source [file join $fullPkgPath simple.tcl]]}}}" \
1.294 + -errorOutput {successful sourcing of simple.tcl
1.295 +packages provided were {simple 1.0}
1.296 +processed simple.tcl
1.297 +}
1.298 +
1.299 +removeFile [file join pkg simple.tcl]
1.300 +
1.301 +makeFile {
1.302 +# Contains global symbols, used to check that they don't have a leading ::
1.303 +package provide global 1.0
1.304 +proc global_lower { stg } {
1.305 + return [string tolower $stg]
1.306 +}
1.307 +proc global_upper { stg } {
1.308 + return [string toupper $stg]
1.309 +}
1.310 +} [file join pkg global.tcl]
1.311 +
1.312 +test pkgMkIndex-3.1 {simple package with global symbols} {
1.313 + pkgtest::runIndex -lazy $fullPkgPath global.tcl
1.314 +} {0 {{global:1.0 {tclPkgSetup {global.tcl source {global_lower global_upper}}}}}}
1.315 +
1.316 +removeFile [file join pkg global.tcl]
1.317 +
1.318 +makeFile {
1.319 +# This package is required by pkg1.
1.320 +# This package is split into two files, to test packages that are split
1.321 +# over multiple files.
1.322 +package provide pkg2 1.0
1.323 +namespace eval pkg2 {
1.324 + namespace export p2-1
1.325 +}
1.326 +proc pkg2::p2-1 { num } {
1.327 + return [expr $num * 2]
1.328 +}
1.329 +} [file join pkg pkg2_a.tcl]
1.330 +
1.331 +makeFile {
1.332 +# This package is required by pkg1.
1.333 +# This package is split into two files, to test packages that are split
1.334 +# over multiple files.
1.335 +package provide pkg2 1.0
1.336 +namespace eval pkg2 {
1.337 + namespace export p2-2
1.338 +}
1.339 +proc pkg2::p2-2 { num } {
1.340 + return [expr $num * 3]
1.341 +}
1.342 +} [file join pkg pkg2_b.tcl]
1.343 +
1.344 +test pkgMkIndex-4.1 {split package} {
1.345 + pkgtest::runIndex -lazy $fullPkgPath pkg2_a.tcl pkg2_b.tcl
1.346 +} {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}}}}
1.347 +
1.348 +test pkgMkIndex-4.2 {split package - direct loading} {
1.349 + pkgtest::runIndex -direct $fullPkgPath pkg2_a.tcl pkg2_b.tcl
1.350 +} "0 {{pkg2:1.0 {[list source [file join $fullPkgPath pkg2_a.tcl]]
1.351 +[list source [file join $fullPkgPath pkg2_b.tcl]]}}}"
1.352 +
1.353 +# Add the direct1 directory to auto_path, so that the direct1 package
1.354 +# can be found.
1.355 +set direct1 [makeDirectory direct1]
1.356 +lappend auto_path $direct1
1.357 +makeFile {
1.358 +# This is referenced by pkgIndex.tcl as a -direct script.
1.359 +package provide direct1 1.0
1.360 +namespace eval direct1 {
1.361 + namespace export pd1 pd2
1.362 +}
1.363 +proc direct1::pd1 { stg } {
1.364 + return [string tolower $stg]
1.365 +}
1.366 +proc direct1::pd2 { stg } {
1.367 + return [string toupper $stg]
1.368 +}
1.369 +} [file join direct1 direct1.tcl]
1.370 +pkg_mkIndex -direct $direct1 direct1.tcl
1.371 +
1.372 +makeFile {
1.373 +# Does a package require of direct1, whose pkgIndex.tcl entry
1.374 +# is created above with option -direct. This tests that pkg_mkIndex
1.375 +# can handle code that is sourced in pkgIndex.tcl files.
1.376 +package require direct1
1.377 +package provide std 1.0
1.378 +namespace eval std {
1.379 + namespace export p1 p2
1.380 +}
1.381 +proc std::p1 { stg } {
1.382 + return [string tolower $stg]
1.383 +}
1.384 +proc std::p2 { stg } {
1.385 + return [string toupper $stg]
1.386 +}
1.387 +} [file join pkg std.tcl]
1.388 +
1.389 +test pkgMkIndex-5.1 {requires -direct package} {
1.390 + pkgtest::runIndex -lazy $fullPkgPath std.tcl
1.391 +} {0 {{std:1.0 {tclPkgSetup {std.tcl source {::std::p1 ::std::p2}}}}}}
1.392 +
1.393 +removeFile [file join direct1 direct1.tcl]
1.394 +file delete [file join $direct1 pkgIndex.tcl]
1.395 +removeDirectory direct1
1.396 +removeFile [file join pkg std.tcl]
1.397 +
1.398 +makeFile {
1.399 +# This package requires pkg3, but it does
1.400 +# not use any of pkg3's procs in the code that is executed by the file
1.401 +# (i.e. references to pkg3's procs are in the proc bodies only).
1.402 +package require pkg3 1.0
1.403 +package provide pkg1 1.0
1.404 +namespace eval pkg1 {
1.405 + namespace export p1-1 p1-2
1.406 +}
1.407 +proc pkg1::p1-1 { num } {
1.408 + return [pkg3::p3-1 $num]
1.409 +}
1.410 +proc pkg1::p1-2 { num } {
1.411 + return [pkg3::p3-2 $num]
1.412 +}
1.413 +} [file join pkg pkg1.tcl]
1.414 +
1.415 +makeFile {
1.416 +package provide pkg3 1.0
1.417 +namespace eval pkg3 {
1.418 + namespace export p3-1 p3-2
1.419 +}
1.420 +proc pkg3::p3-1 { num } {
1.421 + return {[expr $num * 2]}
1.422 +}
1.423 +proc pkg3::p3-2 { num } {
1.424 + return {[expr $num * 3]}
1.425 +}
1.426 +} [file join pkg pkg3.tcl]
1.427 +
1.428 +test pkgMkIndex-6.1 {pkg1 requires pkg3} {
1.429 + pkgtest::runIndex -lazy $fullPkgPath pkg1.tcl pkg3.tcl
1.430 +} {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}}}}}}
1.431 +
1.432 +test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} {
1.433 + pkgtest::runIndex -direct $fullPkgPath pkg1.tcl pkg3.tcl
1.434 +} "0 {{pkg1:1.0 {[list source [file join $fullPkgPath pkg1.tcl]]}} {pkg3:1.0 {[list source [file join $fullPkgPath pkg3.tcl]]}}}"
1.435 +
1.436 +removeFile [file join pkg pkg1.tcl]
1.437 +
1.438 +makeFile {
1.439 +# This package requires pkg3, and it calls
1.440 +# a pkg3 proc in the code that is executed by the file
1.441 +package require pkg3 1.0
1.442 +package provide pkg4 1.0
1.443 +namespace eval pkg4 {
1.444 + namespace export p4-1 p4-2
1.445 + variable m2 [pkg3::p3-1 10]
1.446 +}
1.447 +proc pkg4::p4-1 { num } {
1.448 + variable m2
1.449 + return [expr {$m2 * $num}]
1.450 +}
1.451 +proc pkg4::p4-2 { num } {
1.452 + return [pkg3::p3-2 $num]
1.453 +}
1.454 +} [file join pkg pkg4.tcl]
1.455 +
1.456 +test pkgMkIndex-7.1 {pkg4 uses pkg3} {
1.457 + pkgtest::runIndex -lazy $fullPkgPath pkg4.tcl pkg3.tcl
1.458 +} {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}}}}}}
1.459 +
1.460 +test pkgMkIndex-7.2 {pkg4 uses pkg3 - use -direct} {
1.461 + pkgtest::runIndex -direct $fullPkgPath pkg4.tcl pkg3.tcl
1.462 +} "0 {{pkg3:1.0 {[list source [file join $fullPkgPath pkg3.tcl]]}} {pkg4:1.0 {[list source [file join $fullPkgPath pkg4.tcl]]}}}"
1.463 +
1.464 +removeFile [file join pkg pkg4.tcl]
1.465 +removeFile [file join pkg pkg3.tcl]
1.466 +
1.467 +makeFile {
1.468 +# This package requires pkg2, and it calls
1.469 +# a pkg2 proc in the code that is executed by the file.
1.470 +# Pkg2 is a split package.
1.471 +package require pkg2 1.0
1.472 +package provide pkg5 1.0
1.473 +namespace eval pkg5 {
1.474 + namespace export p5-1 p5-2
1.475 + variable m2 [pkg2::p2-1 10]
1.476 + variable m3 [pkg2::p2-2 10]
1.477 +}
1.478 +proc pkg5::p5-1 { num } {
1.479 + variable m2
1.480 + return [expr {$m2 * $num}]
1.481 +}
1.482 +proc pkg5::p5-2 { num } {
1.483 + variable m2
1.484 + return [expr {$m2 * $num}]
1.485 +}
1.486 +} [file join pkg pkg5.tcl]
1.487 +
1.488 +test pkgMkIndex-8.1 {pkg5 uses pkg2} {
1.489 + pkgtest::runIndex -lazy $fullPkgPath pkg5.tcl pkg2_a.tcl pkg2_b.tcl
1.490 +} {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}}}}}}
1.491 +
1.492 +test pkgMkIndex-8.2 {pkg5 uses pkg2 - use -direct} {
1.493 + pkgtest::runIndex -direct $fullPkgPath pkg5.tcl pkg2_a.tcl pkg2_b.tcl
1.494 +} "0 {{pkg2:1.0 {[list source [file join $fullPkgPath pkg2_a.tcl]]
1.495 +[list source [file join $fullPkgPath pkg2_b.tcl]]}} {pkg5:1.0 {[list source [file join $fullPkgPath pkg5.tcl]]}}}"
1.496 +
1.497 +removeFile [file join pkg pkg5.tcl]
1.498 +removeFile [file join pkg pkg2_a.tcl]
1.499 +removeFile [file join pkg pkg2_b.tcl]
1.500 +
1.501 +makeFile {
1.502 +# This package requires circ2, and circ2
1.503 +# requires circ3, which in turn requires circ1.
1.504 +# In case of cirularities, pkg_mkIndex should give up when it gets stuck.
1.505 +package require circ2 1.0
1.506 +package provide circ1 1.0
1.507 +namespace eval circ1 {
1.508 + namespace export c1-1 c1-2 c1-3 c1-4
1.509 +}
1.510 +proc circ1::c1-1 { num } {
1.511 + return [circ2::c2-1 $num]
1.512 +}
1.513 +proc circ1::c1-2 { num } {
1.514 + return [circ2::c2-2 $num]
1.515 +}
1.516 +proc circ1::c1-3 {} {
1.517 + return 10
1.518 +}
1.519 +proc circ1::c1-4 {} {
1.520 + return 20
1.521 +}
1.522 +} [file join pkg circ1.tcl]
1.523 +
1.524 +makeFile {
1.525 +# This package is required by circ1, and
1.526 +# requires circ3. Circ3, in turn, requires circ1 to give us a circularity.
1.527 +package require circ3 1.0
1.528 +package provide circ2 1.0
1.529 +namespace eval circ2 {
1.530 + namespace export c2-1 c2-2
1.531 +}
1.532 +proc circ2::c2-1 { num } {
1.533 + return [expr $num * [circ3::c3-1]]
1.534 +}
1.535 +proc circ2::c2-2 { num } {
1.536 + return [expr $num * [circ3::c3-2]]
1.537 +}
1.538 +} [file join pkg circ2.tcl]
1.539 +
1.540 +makeFile {
1.541 +# This package is required by circ2, and in
1.542 +# turn requires circ1. This closes the circularity.
1.543 +package require circ1 1.0
1.544 +package provide circ3 1.0
1.545 +namespace eval circ3 {
1.546 + namespace export c3-1 c3-4
1.547 +}
1.548 +proc circ3::c3-1 {} {
1.549 + return [circ1::c1-3]
1.550 +}
1.551 +proc circ3::c3-2 {} {
1.552 + return [circ1::c1-4]
1.553 +}
1.554 +} [file join pkg circ3.tcl]
1.555 +
1.556 +test pkgMkIndex-9.1 {circular packages} {
1.557 + pkgtest::runIndex -lazy $fullPkgPath circ1.tcl circ2.tcl circ3.tcl
1.558 +} {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}}}}}
1.559 +
1.560 +removeFile [file join pkg circ1.tcl]
1.561 +removeFile [file join pkg circ2.tcl]
1.562 +removeFile [file join pkg circ3.tcl]
1.563 +
1.564 +# Some tests require the existence of one of the DLLs in the dltest directory
1.565 +set x [file join [file dirname [info nameofexecutable]] dltest \
1.566 + pkga[info sharedlibextension]]
1.567 +set dll "[file tail $x]Required"
1.568 +::tcltest::testConstraint $dll [file exists $x]
1.569 +
1.570 +if {[testConstraint $dll]} {
1.571 +makeFile {
1.572 +# This package provides Pkga, which is also provided by a DLL.
1.573 +package provide Pkga 1.0
1.574 +proc pkga_neq { x } {
1.575 + return [expr {! [pkgq_eq $x]}]
1.576 +}
1.577 +} [file join pkg pkga.tcl]
1.578 +file copy -force $x $fullPkgPath
1.579 +}
1.580 +testConstraint exec [llength [info commands ::exec]]
1.581 +
1.582 +test pkgMkIndex-10.1 {package in DLL and script} [list exec $dll] {
1.583 + # Do all [load]ing of shared libraries in another process, so
1.584 + # we can delete the file and not get stuck because we're holding
1.585 + # a reference to it.
1.586 + set cmd [list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]
1.587 + exec [interpreter] << $cmd
1.588 + pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl
1.589 +} "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
1.590 +test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] {
1.591 + # Do all [load]ing of shared libraries in another process, so
1.592 + # we can delete the file and not get stuck because we're holding
1.593 + # a reference to it.
1.594 + #
1.595 + # This test depends on context from prior test, so repeat it.
1.596 + set script "[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]\n"
1.597 + append script \
1.598 + "[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]"
1.599 + exec [interpreter] << $script
1.600 + pkgtest::runCreatedIndex {0 {}} -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension]
1.601 +} {0 {}}
1.602 +
1.603 +if {[testConstraint $dll]} {
1.604 +file delete -force [file join $fullPkgPath [file tail $x]]
1.605 +removeFile [file join pkg pkga.tcl]
1.606 +}
1.607 +
1.608 +# Tolerate "namespace import" at the global scope
1.609 +
1.610 +makeFile {
1.611 +package provide fubar 1.0
1.612 +namespace eval ::fubar:: {
1.613 + #
1.614 + # export only public functions.
1.615 + #
1.616 + namespace export {[a-z]*}
1.617 +}
1.618 +proc ::fubar::foo {bar} {
1.619 + puts "$bar"
1.620 + return true
1.621 +}
1.622 +namespace import ::fubar::foo
1.623 +} [file join pkg import.tcl]
1.624 +
1.625 +test pkgMkIndex-11.1 {conflicting namespace imports} {
1.626 + pkgtest::runIndex -lazy $fullPkgPath import.tcl
1.627 +} {0 {{fubar:1.0 {tclPkgSetup {import.tcl source ::fubar::foo}}}}}
1.628 +
1.629 +removeFile [file join pkg import.tcl]
1.630 +
1.631 +# Verify that the auto load list generated is correct even when there
1.632 +# is a proc name conflict between two namespaces (ie, ::foo::baz and
1.633 +# ::bar::baz)
1.634 +
1.635 +makeFile {
1.636 +package provide football 1.0
1.637 +namespace eval ::pro:: {
1.638 + #
1.639 + # export only public functions.
1.640 + #
1.641 + namespace export {[a-z]*}
1.642 +}
1.643 +namespace eval ::college:: {
1.644 + #
1.645 + # export only public functions.
1.646 + #
1.647 + namespace export {[a-z]*}
1.648 +}
1.649 +proc ::pro::team {} {
1.650 + puts "go packers!"
1.651 + return true
1.652 +}
1.653 +proc ::college::team {} {
1.654 + puts "go badgers!"
1.655 + return true
1.656 +}
1.657 +} [file join pkg samename.tcl]
1.658 +
1.659 +test pkgMkIndex-12.1 {same name procs in different namespace} {
1.660 + pkgtest::runIndex -lazy $fullPkgPath samename.tcl
1.661 +} {0 {{football:1.0 {tclPkgSetup {samename.tcl source {::college::team ::pro::team}}}}}}
1.662 +
1.663 +removeFile [file join pkg samename.tcl]
1.664 +
1.665 +# Proc names with embedded spaces are properly listed (ie, correct number of
1.666 +# braces) in result
1.667 +makeFile {
1.668 +package provide spacename 1.0
1.669 +proc {a b} {} {}
1.670 +proc {c d} {} {}
1.671 +} [file join pkg spacename.tcl]
1.672 +
1.673 +test pkgMkIndex-13.1 {proc names with embedded spaces} {
1.674 + pkgtest::runIndex -lazy $fullPkgPath spacename.tcl
1.675 +} {0 {{spacename:1.0 {tclPkgSetup {spacename.tcl source {{a b} {c d}}}}}}}
1.676 +
1.677 +removeFile [file join pkg spacename.tcl]
1.678 +
1.679 +# Test the pkg_compareExtension helper function
1.680 +test pkgMkIndex-14.1 {pkg_compareExtension} {unixOnly} {
1.681 + pkg_compareExtension foo.so .so
1.682 +} 1
1.683 +test pkgMkIndex-14.2 {pkg_compareExtension} {unixOnly} {
1.684 + pkg_compareExtension foo.so.bar .so
1.685 +} 0
1.686 +test pkgMkIndex-14.3 {pkg_compareExtension} {unixOnly} {
1.687 + pkg_compareExtension foo.so.1 .so
1.688 +} 1
1.689 +test pkgMkIndex-14.4 {pkg_compareExtension} {unixOnly} {
1.690 + pkg_compareExtension foo.so.1.2 .so
1.691 +} 1
1.692 +test pkgMkIndex-14.5 {pkg_compareExtension} {unixOnly} {
1.693 + pkg_compareExtension foo .so
1.694 +} 0
1.695 +test pkgMkIndex-14.6 {pkg_compareExtension} {unixOnly} {
1.696 + pkg_compareExtension foo.so.1.2.bar .so
1.697 +} 0
1.698 +
1.699 +# cleanup
1.700 +
1.701 +removeDirectory pkg
1.702 +
1.703 +namespace delete pkgtest
1.704 +::tcltest::cleanupTests
1.705 +return
1.706 +