diff options
author | welch <welch> | 1998-07-24 14:31:08 (GMT) |
---|---|---|
committer | welch <welch> | 1998-07-24 14:31:08 (GMT) |
commit | 8f081319f9e8507c94b6a2a0a58db00913ccdab9 (patch) | |
tree | 1ef2f1a187397c69fd3174ea1de0ce93b96b7b73 | |
parent | 31bbea25be0b7678d1c26d53f38aa3c266c62d99 (diff) | |
download | tcl-8f081319f9e8507c94b6a2a0a58db00913ccdab9.zip tcl-8f081319f9e8507c94b6a2a0a58db00913ccdab9.tar.gz tcl-8f081319f9e8507c94b6a2a0a58db00913ccdab9.tar.bz2 |
Initial revision
-rw-r--r-- | tests/autoMkindex.tcl | 52 | ||||
-rw-r--r-- | tests/autoMkindex.test | 55 |
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" |