summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorwelch <welch>1998-11-12 05:54:21 (GMT)
committerwelch <welch>1998-11-12 05:54:21 (GMT)
commit9d8456a7c25586290e4119e7bc7fa5d506e58805 (patch)
tree3dd6f1fef668245c6681a33badfe956ae560f52b
parentc2bba04f0c60b8ff2d317f442016649f61261666 (diff)
downloadtcl-9d8456a7c25586290e4119e7bc7fa5d506e58805.zip
tcl-9d8456a7c25586290e4119e7bc7fa5d506e58805.tar.gz
tcl-9d8456a7c25586290e4119e7bc7fa5d506e58805.tar.bz2
Added test cases for new pkg_mkIndex -load case
-rw-r--r--tests/load.test4
-rw-r--r--tests/pkgMkIndex.test103
2 files changed, 43 insertions, 64 deletions
diff --git a/tests/load.test b/tests/load.test
index 17affb7..d5b27ae 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: load.test,v 1.2 1998/09/14 18:40:11 stanton Exp $
+# RCS: @(#) $Id: load.test,v 1.3 1998/11/12 05:54:21 welch Exp $
if {[string compare test [info procs test]] == 1} then {source defs}
@@ -27,7 +27,7 @@ if ![file readable [file join $testDir pkga$ext]] {
return
}
-if [string match *pkga* [set alreadyLoaded [info loaded {}]]] {
+if [string match *pkga* [set alreadyLoaded [info loaded]]] {
puts "load tests have already been run once: skipping (can't rerun)"
return
}
diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test
index abec11c..3251feb 100644
--- a/tests/pkgMkIndex.test
+++ b/tests/pkgMkIndex.test
@@ -8,7 +8,7 @@
# Copyright (c) 1998 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: pkgMkIndex.test,v 1.3 1998/11/10 06:54:11 jingham Exp $
+# RCS: @(#) $Id: pkgMkIndex.test,v 1.4 1998/11/12 05:54:21 welch Exp $
if {[string compare test [info procs test]] == 1} then {source defs}
@@ -20,32 +20,11 @@ set scriptDir [file dirname [info script]]
set oldDir [pwd]
lappend auto_path [file join [pwd] $scriptDir pkg1]
-# pkgproc --
-#
-# Wraps around proc, saves the name of the procedure in procList, so that
-# the procedure can be undefined at the end.
-#
-# Arguments:
-# procName procedure name
-# argList arguments list
-# body procedure body
-#
-# Results:
-# Returns the return value of proc
-
-proc pkgproc { procName argList body } {
- set result [proc $procName $argList $body]
-
- lappend ::procList $procName
-
- return $result
+namespace eval pkgtest {
+ # Namespace for procs we can discard
}
-set ::procList pkgproc
-
-set ::pkgDriverCount 0
-
-# parseArgs --
+# pkgtest::parseArgs --
#
# Parse an argument list.
#
@@ -63,7 +42,7 @@ set ::pkgDriverCount 0
# 1: the directory to index
# 2: the patterns list
-pkgproc parseArgs { args } {
+proc pkgtest::parseArgs { args } {
set options ""
set argc [llength $args]
@@ -71,6 +50,10 @@ pkgproc parseArgs { args } {
set a [lindex $args $iarg]
if {[regexp {^-} $a]} {
lappend options $a
+ if {[string compare -load $a] == 0} {
+ incr iarg
+ lappend options [lindex $args $iarg]
+ }
} else {
break
}
@@ -83,7 +66,7 @@ pkgproc parseArgs { args } {
return [list $options $dirPath $patternList]
}
-# parsePkgIndex --
+# pkgtest::parseIndex --
#
# Loads a pkgIndex.tcl file, records all the calls to "package ifneeded".
#
@@ -95,7 +78,7 @@ pkgproc parseArgs { args } {
# name and version (in the form "$name:$version"), and the values the rest
# of the command line.
-pkgproc parsePkgIndex { filePath } {
+proc pkgtest::parseIndex { filePath } {
# create a slave interpreter, where we override "package ifneeded"
set slave [interp create]
@@ -147,7 +130,7 @@ pkgproc parsePkgIndex { filePath } {
return $PKGS
}
-# createIndex --
+# pkgtest::createIndex --
#
# Runs pkg_mkIndex for the given directory and set of patterns.
# This procedure deletes any pkgIndex.tcl file in the target directory,
@@ -166,7 +149,7 @@ pkgproc parsePkgIndex { filePath } {
# 0: 1 if the procedure encountered an error, 0 otherwise.
# 1: the error result if element 0 was 1
-pkgproc createIndex { args } {
+proc pkgtest::createIndex { args } {
set parsed [eval parseArgs $args]
set options [lindex $parsed 0]
set dirPath [lindex $parsed 1]
@@ -184,11 +167,11 @@ pkgproc createIndex { args } {
# makePkgList --
#
-# Takes the output of a parsePkgIndex call, filters it and returns a
+# Takes the output of a pkgtest::parseIndex call, filters it and returns a
# cleaned up list of packages and their actions.
#
# Arguments:
-# inList output from a parsePkgIndex.
+# inList output from a pkgtest::parseIndex.
#
# Results:
# Returns a list of two element lists:
@@ -200,7 +183,7 @@ pkgproc createIndex { args } {
# 2: the second file ...
# N: the N-1st file ...
-pkgproc makePkgList { inList } {
+proc makePkgList { inList } {
set pkgList ""
foreach {k v} $inList {
@@ -227,7 +210,7 @@ pkgproc makePkgList { inList } {
return $pkgList
}
-# runIndex --
+# pkgtest::runIndex --
#
# Runs pkg_mkIndex, parses the generated index file.
#
@@ -243,10 +226,10 @@ pkgproc makePkgList { inList } {
# Returns a two element list:
# 0: 1 if the procedure encountered an error, 0 otherwise.
# 1: if no error, this is the parsed generated index file, in the format
-# returned by parsePkgIndex.
+# returned by pkgtest::parseIndex.
# If error, this is the error result.
-pkgproc runIndex { args } {
+proc pkgtest::runIndex { args } {
set rv [eval createIndex $args]
if {[lindex $rv 0] == 0} {
set parsed [eval parseArgs $args]
@@ -254,7 +237,7 @@ pkgproc runIndex { args } {
set idxFile [file join $dirPath pkgIndex.tcl]
if {[catch {
- set result [list 0 [makePkgList [parsePkgIndex $idxFile]]]
+ set result [list 0 [makePkgList [parseIndex $idxFile]]]
} err]} {
set result [list 1 $err]
}
@@ -270,27 +253,27 @@ pkgproc runIndex { args } {
# changed on us
test pkgMkIndex-1.1 {nothing matches pattern - current dir is the same} {
- list [runIndex pkg nomatch.tcl] [pwd]
+ list [pkgtest::runIndex pkg nomatch.tcl] [pwd]
} [list {1 {no files matched glob pattern "nomatch.tcl"}} [pwd]]
cd $oldDir ;# 'cause 8.0.3 is left in the wrong place
test pkgMkIndex-2.1 {simple package} {
- runIndex pkg simple.tcl
+ pkgtest::runIndex pkg simple.tcl
} {0 {{simple:1.0 {tclPkgSetup {simple.tcl source {::simple::lower ::simple::upper}}}}}}
test pkgMkIndex-2.2 {simple package - use -direct} {
- runIndex -direct pkg simple.tcl
+ pkgtest::runIndex -direct pkg simple.tcl
} "0 {{simple:1.0 {source [file join pkg simple.tcl]}}}"
test pkgMkIndex-3.1 {simple package with global symbols} {
- runIndex pkg global.tcl
+ pkgtest::runIndex pkg global.tcl
} {0 {{global:1.0 {tclPkgSetup {global.tcl source {global_lower global_upper}}}}}}
test pkgMkIndex-4.1 {split package} {
- runIndex pkg pkg2_a.tcl pkg2_b.tcl
+ pkgtest::runIndex pkg pkg2_a.tcl pkg2_b.tcl
} {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}}}}
test pkgMkIndex-4.2 {split package - direct loading} {
- runIndex -direct pkg pkg2_a.tcl pkg2_b.tcl
+ pkgtest::runIndex -direct pkg pkg2_a.tcl pkg2_b.tcl
} "0 {{pkg2:1.0 {source [file join pkg pkg2_a.tcl]
source [file join pkg pkg2_b.tcl]}}}"
@@ -301,36 +284,36 @@ source [file join pkg pkg2_b.tcl]}}}"
# Both failures are caused by Tcl code executed in pkgIndex.tcl.
test pkgMkIndex-5.1 {requires -direct package} {
- runIndex pkg std.tcl
+ pkgtest::runIndex pkg std.tcl
} {0 {{std:1.0 {tclPkgSetup {std.tcl source {::std::p1 ::std::p2}}}}}}
test pkgMkIndex-6.1 {pkg1 requires pkg3} {
- runIndex pkg pkg1.tcl pkg3.tcl
+ pkgtest::runIndex pkg pkg1.tcl pkg3.tcl
} {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}}}}}}
test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} {
- runIndex -direct pkg pkg1.tcl pkg3.tcl
+ pkgtest::runIndex -direct pkg pkg1.tcl pkg3.tcl
} "0 {{pkg1:1.0 {source [file join pkg pkg1.tcl]}} {pkg3:1.0 {source [file join pkg pkg3.tcl]}}}"
test pkgMkIndex-7.1 {pkg4 uses pkg3} {
- runIndex pkg pkg4.tcl pkg3.tcl
+ pkgtest::runIndex pkg pkg4.tcl pkg3.tcl
} {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}}}}}}
test pkgMkIndex-7.2 {pkg4 uses pkg3 - use -direct} {
- runIndex -direct pkg pkg4.tcl pkg3.tcl
+ pkgtest::runIndex -direct pkg pkg4.tcl pkg3.tcl
} "0 {{pkg3:1.0 {source [file join pkg pkg3.tcl]}} {pkg4:1.0 {source [file join pkg pkg4.tcl]}}}"
test pkgMkIndex-8.1 {pkg5 uses pkg2} {
- runIndex pkg pkg5.tcl pkg2_a.tcl pkg2_b.tcl
+ pkgtest::runIndex pkg pkg5.tcl pkg2_a.tcl pkg2_b.tcl
} {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}}}}}}
test pkgMkIndex-8.2 {pkg5 uses pkg2 - use -direct} {
- runIndex -direct pkg pkg5.tcl pkg2_a.tcl pkg2_b.tcl
+ pkgtest::runIndex -direct pkg pkg5.tcl pkg2_a.tcl pkg2_b.tcl
} "0 {{pkg2:1.0 {source [file join pkg pkg2_a.tcl]
source [file join pkg pkg2_b.tcl]}} {pkg5:1.0 {source [file join pkg pkg5.tcl]}}}"
test pkgMkIndex-9.1 {circular packages} {
- runIndex pkg circ1.tcl circ2.tcl circ3.tcl
+ pkgtest::runIndex pkg circ1.tcl circ2.tcl circ3.tcl
} {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}}}}}
# Try to find one of the DLLs in the dltest directory
@@ -339,8 +322,11 @@ set x [file join $x ../unix/dltest/pkga[info sharedlibextension]]
if {[file exists $x]} {
file copy -force $x pkg
test pkgMkIndex-10.1 {package in DLL and script} {
- runIndex pkg pkga.tcl pkga[info sharedlibextension]
- } {0 {{Pkga:1.0 {tclPkgSetup {pkga.tcl source pkga_neq} {pkga.so load {pkga_eq pkga_quote}}}}}}
+ pkgtest::runIndex pkg pkga[info sharedlibextension] pkga.tcl
+ } {0 {{Pkga:1.0 {tclPkgSetup {pkga.so load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}}
+ test pkgMkIndex-10.2 {package in DLL hidden by -load} {
+ pkgtest::runIndex -load Pkg* -- pkg pkga[info sharedlibextension]
+ } {0 {}}
} else {
puts "Skipping pkgMkIndex-10.1 (index of DLL and script)"
}
@@ -349,13 +335,6 @@ if {[file exists $x]} {
# cleanup
#
if {![info exist TESTS]} {
-
-file delete [file join pkg pkgIndex.tcl]
-
-foreach p $::procList {
- rename $p {}
-}
-
-unset ::procList
-unset ::pkgDriverCount
+ file delete [file join pkg pkgIndex.tcl]
+ namespace delete pkgtest
}