summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorwelch <welch>1998-07-24 14:31:08 (GMT)
committerwelch <welch>1998-07-24 14:31:08 (GMT)
commit8f081319f9e8507c94b6a2a0a58db00913ccdab9 (patch)
tree1ef2f1a187397c69fd3174ea1de0ce93b96b7b73
parent31bbea25be0b7678d1c26d53f38aa3c266c62d99 (diff)
downloadtcl-8f081319f9e8507c94b6a2a0a58db00913ccdab9.zip
tcl-8f081319f9e8507c94b6a2a0a58db00913ccdab9.tar.gz
tcl-8f081319f9e8507c94b6a2a0a58db00913ccdab9.tar.bz2
Initial revision
-rw-r--r--tests/autoMkindex.tcl52
-rw-r--r--tests/autoMkindex.test55
2 files changed, 107 insertions, 0 deletions
diff --git a/tests/autoMkindex.tcl b/tests/autoMkindex.tcl
new file mode 100644
index 0000000..7a72fbe
--- /dev/null
+++ b/tests/autoMkindex.tcl
@@ -0,0 +1,52 @@
+# Test file for:
+# auto_mkindex
+#
+# This file provides example cases for testing the Tcl autoloading
+# facility. Things are much more complicated with namespaces and classes.
+# The "auto_mkindex" facility can no longer be built on top of a simple
+# regular expression parser. It must recognize constructs like this:
+#
+# namespace eval foo {
+# proc test {x y} { ... }
+# namespace eval bar {
+# proc another {args} { ... }
+# }
+# }
+#
+# Note that procedures and itcl class definitions can be nested inside
+# of namespaces.
+#
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+
+# This shouldn't cause any problems
+namespace import -force blt::*
+
+# Should be able to handle "proc" definitions, even if they are
+# preceded by white space.
+
+proc normal {x y} {return [expr $x+$y]}
+ proc indented {x y} {return [expr $x+$y]}
+
+#
+# Should be able to handle proc declarations within namespaces,
+# even if they have explicit namespace paths.
+#
+namespace eval buried {
+ proc inside {args} {return "inside: $args"}
+
+ namespace export pub_*
+ proc pub_one {args} {return "one: $args"}
+ proc pub_two {args} {return "two: $args"}
+}
+proc buried::within {args} {return "within: $args"}
+
+namespace eval buried {
+ namespace eval under {
+ proc neath {args} {return "neath: $args"}
+ }
+ namespace eval ::buried {
+ proc relative {args} {return "relative: $args"}
+ proc ::top {args} {return "top: $args"}
+ proc ::buried::explicit {args} {return "explicit: $args"}
+ }
+}
diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test
new file mode 100644
index 0000000..cf5bffc
--- /dev/null
+++ b/tests/autoMkindex.test
@@ -0,0 +1,55 @@
+# Commands covered: auto_mkindex auto_import
+#
+# This file contains tests related to autoloading and generating
+# the autoloading index.
+#
+# Copyright (c) 1998 Lucent Technologies, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: $Id: autoMkindex.test,v 1.1 1998/07/24 14:31:08 welch Exp $
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test autoMkindex-1.1 {remove any existing tclIndex file} {
+ file delete tclIndex
+ file exists tclIndex
+} {0}
+
+test autoMkindex-1.2 {build tclIndex based on a test file} {
+ auto_mkindex . autoMkindex.tcl
+ file exists tclIndex
+} {1}
+
+set element "{source [file join . autoMkindex.tcl]}"
+
+test autoMkindex-1.3 {examine tclIndex} {
+ namespace eval tcl_autoMkindex_tmp {
+ set dir "."
+ variable auto_index
+ source tclIndex
+ set result ""
+ foreach elem [lsort [array names auto_index]] {
+ lappend result [list $elem $auto_index($elem)]
+ }
+ set result
+ }
+} "{::buried::explicit $element} {::buried::inside $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {indented $element} {normal $element} {top $element}"
+
+namespace delete tcl_autoMkindex_tmp
+
+test autoMkindex-2.1 {commands on the autoload path can be imported} {
+ set interp [interp create]
+ set final [$interp eval {
+ namespace eval blt {}
+ set auto_path [linsert $auto_path 0 .]
+ set info [list [catch {namespace import buried::*} result] $result]
+ foreach name [lsort [info commands pub_*]] {
+ lappend info $name [namespace origin $name]
+ }
+ set info
+ }]
+ interp delete $interp
+ set final
+} "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"