os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/autoMkindex.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/autoMkindex.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,359 @@
1.4 +# Commands covered: auto_mkindex auto_import
1.5 +#
1.6 +# This file contains tests related to autoloading and generating
1.7 +# the autoloading index.
1.8 +#
1.9 +# Copyright (c) 1998 Lucent Technologies, Inc.
1.10 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.11 +#
1.12 +# See the file "license.terms" for information on usage and redistribution
1.13 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.14 +#
1.15 +# RCS: @(#) $Id: autoMkindex.test,v 1.14.2.1 2004/10/28 00:01:06 dgp Exp $
1.16 +
1.17 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.18 + package require tcltest 2
1.19 + namespace import -force ::tcltest::*
1.20 +}
1.21 +
1.22 +makeFile {# Test file for:
1.23 +# auto_mkindex
1.24 +#
1.25 +# This file provides example cases for testing the Tcl autoloading
1.26 +# facility. Things are much more complicated with namespaces and classes.
1.27 +# The "auto_mkindex" facility can no longer be built on top of a simple
1.28 +# regular expression parser. It must recognize constructs like this:
1.29 +#
1.30 +# namespace eval foo {
1.31 +# proc test {x y} { ... }
1.32 +# namespace eval bar {
1.33 +# proc another {args} { ... }
1.34 +# }
1.35 +# }
1.36 +#
1.37 +# Note that procedures and itcl class definitions can be nested inside
1.38 +# of namespaces.
1.39 +#
1.40 +# Copyright (c) 1993-1998 Lucent Technologies, Inc.
1.41 +
1.42 +# This shouldn't cause any problems
1.43 +namespace import -force blt::*
1.44 +
1.45 +# Should be able to handle "proc" definitions, even if they are
1.46 +# preceded by white space.
1.47 +
1.48 +proc normal {x y} {return [expr $x+$y]}
1.49 + proc indented {x y} {return [expr $x+$y]}
1.50 +
1.51 +#
1.52 +# Should be able to handle proc declarations within namespaces,
1.53 +# even if they have explicit namespace paths.
1.54 +#
1.55 +namespace eval buried {
1.56 + proc inside {args} {return "inside: $args"}
1.57 +
1.58 + namespace export pub_*
1.59 + proc pub_one {args} {return "one: $args"}
1.60 + proc pub_two {args} {return "two: $args"}
1.61 +}
1.62 +proc buried::within {args} {return "within: $args"}
1.63 +
1.64 +namespace eval buried {
1.65 + namespace eval under {
1.66 + proc neath {args} {return "neath: $args"}
1.67 + }
1.68 + namespace eval ::buried {
1.69 + proc relative {args} {return "relative: $args"}
1.70 + proc ::top {args} {return "top: $args"}
1.71 + proc ::buried::explicit {args} {return "explicit: $args"}
1.72 + }
1.73 +}
1.74 +
1.75 +# With proper hooks, we should be able to support other commands
1.76 +# that create procedures
1.77 +
1.78 +proc buried::myproc {name body args} {
1.79 + ::proc $name $body $args
1.80 +}
1.81 +namespace eval ::buried {
1.82 + proc mycmd1 args {return "mycmd"}
1.83 + myproc mycmd2 args {return "mycmd"}
1.84 +}
1.85 +::buried::myproc mycmd3 args {return "another"}
1.86 +
1.87 +proc {buried::my proc} {name body args} {
1.88 + ::proc $name $body $args
1.89 +}
1.90 +namespace eval ::buried {
1.91 + proc mycmd4 args {return "mycmd"}
1.92 + {my proc} mycmd5 args {return "mycmd"}
1.93 +}
1.94 +{::buried::my proc} mycmd6 args {return "another"}
1.95 +
1.96 +# A correctly functioning [auto_import] won't choke when a child
1.97 +# namespace [namespace import]s from its parent.
1.98 +#
1.99 +namespace eval ::parent::child {
1.100 + namespace import ::parent::*
1.101 +}
1.102 +proc ::parent::child::test {} {}
1.103 +
1.104 +} autoMkindex.tcl
1.105 +
1.106 +
1.107 +# Save initial state of auto_mkindex_parser
1.108 +
1.109 +auto_load auto_mkindex
1.110 +if {[info exists auto_mkindex_parser::initCommands]} {
1.111 + set saveCommands $auto_mkindex_parser::initCommands
1.112 +}
1.113 +proc AutoMkindexTestReset {} {
1.114 + global saveCommands
1.115 + if {[info exists saveCommands]} {
1.116 + set auto_mkindex_parser::initCommands $saveCommands
1.117 + } elseif {[info exists auto_mkindex_parser::initCommands]} {
1.118 + unset auto_mkindex_parser::initCommands
1.119 + }
1.120 +}
1.121 +
1.122 +set result ""
1.123 +
1.124 +set origDir [pwd]
1.125 +cd $::tcltest::temporaryDirectory
1.126 +
1.127 +test autoMkindex-1.1 {remove any existing tclIndex file} {
1.128 + file delete tclIndex
1.129 + file exists tclIndex
1.130 +} {0}
1.131 +
1.132 +test autoMkindex-1.2 {build tclIndex based on a test file} {
1.133 + auto_mkindex . autoMkindex.tcl
1.134 + file exists tclIndex
1.135 +} {1}
1.136 +
1.137 +set element "{source [file join . autoMkindex.tcl]}"
1.138 +
1.139 +test autoMkindex-1.3 {examine tclIndex} {
1.140 + file delete tclIndex
1.141 + auto_mkindex . autoMkindex.tcl
1.142 + namespace eval tcl_autoMkindex_tmp {
1.143 + set dir "."
1.144 + variable auto_index
1.145 + source tclIndex
1.146 + set ::result ""
1.147 + foreach elem [lsort [array names auto_index]] {
1.148 + lappend ::result [list $elem $auto_index($elem)]
1.149 + }
1.150 + }
1.151 + namespace delete tcl_autoMkindex_tmp
1.152 + set ::result
1.153 +} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {normal $element} {top $element}"
1.154 +
1.155 +
1.156 +test autoMkindex-2.1 {commands on the autoload path can be imported} {
1.157 + file delete tclIndex
1.158 + auto_mkindex . autoMkindex.tcl
1.159 + set interp [interp create]
1.160 + set final [$interp eval {
1.161 + namespace eval blt {}
1.162 + set auto_path [linsert $auto_path 0 .]
1.163 + set info [list [catch {namespace import buried::*} result] $result]
1.164 + foreach name [lsort [info commands pub_*]] {
1.165 + lappend info $name [namespace origin $name]
1.166 + }
1.167 + set info
1.168 + }]
1.169 + interp delete $interp
1.170 + set final
1.171 +} "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"
1.172 +
1.173 +# Test auto_mkindex hooks
1.174 +
1.175 +# Slave hook executes interesting code in the interp used to watch code.
1.176 +
1.177 +test autoMkindex-3.1 {slaveHook} {
1.178 + auto_mkindex_parser::slavehook {
1.179 + _%@namespace eval ::blt {
1.180 + proc foo {} {}
1.181 + _%@namespace export foo
1.182 + }
1.183 + }
1.184 + auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* }
1.185 + file delete tclIndex
1.186 + auto_mkindex . autoMkindex.tcl
1.187 +
1.188 + # Reset initCommands to avoid trashing other tests
1.189 +
1.190 + AutoMkindexTestReset
1.191 + file exists tclIndex
1.192 +} 1
1.193 +
1.194 +# The auto_mkindex_parser::command is used to register commands
1.195 +# that create new commands.
1.196 +
1.197 +test autoMkindex-3.2 {auto_mkindex_parser::command} {
1.198 + auto_mkindex_parser::command buried::myproc {name args} {
1.199 + variable index
1.200 + variable scriptFile
1.201 + append index [list set auto_index([fullname $name])] \
1.202 + " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
1.203 + }
1.204 + file delete tclIndex
1.205 + auto_mkindex . autoMkindex.tcl
1.206 + namespace eval tcl_autoMkindex_tmp {
1.207 + set dir "."
1.208 + variable auto_index
1.209 + source tclIndex
1.210 + set ::result ""
1.211 + foreach elem [lsort [array names auto_index]] {
1.212 + lappend ::result [list $elem $auto_index($elem)]
1.213 + }
1.214 + }
1.215 + namespace delete tcl_autoMkindex_tmp
1.216 +
1.217 + # Reset initCommands to avoid trashing other tests
1.218 +
1.219 + AutoMkindexTestReset
1.220 + set ::result
1.221 +} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}"
1.222 +
1.223 +
1.224 +test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
1.225 + auto_mkindex_parser::command {buried::my proc} {name args} {
1.226 + variable index
1.227 + variable scriptFile
1.228 + puts "my proc $name"
1.229 + append index [list set auto_index([fullname $name])] \
1.230 + " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
1.231 + }
1.232 + file delete tclIndex
1.233 + auto_mkindex . autoMkindex.tcl
1.234 + namespace eval tcl_autoMkindex_tmp {
1.235 + set dir "."
1.236 + variable auto_index
1.237 + source tclIndex
1.238 + set ::result ""
1.239 + foreach elem [lsort [array names auto_index]] {
1.240 + lappend ::result [list $elem $auto_index($elem)]
1.241 + }
1.242 + }
1.243 + namespace delete tcl_autoMkindex_tmp
1.244 +
1.245 + # Reset initCommands to avoid trashing other tests
1.246 +
1.247 + AutoMkindexTestReset
1.248 + proc lvalue {list pattern} {
1.249 + set ix [lsearch $list $pattern]
1.250 + if {$ix >= 0} {
1.251 + return [lindex $list $ix]
1.252 + } else {
1.253 + return {}
1.254 + }
1.255 + }
1.256 + list [lvalue $::result *mycmd4*] [lvalue $::result *mycmd5*] [lvalue $::result *mycmd6*]
1.257 +} "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"
1.258 +
1.259 +
1.260 +makeDirectory pkg
1.261 +makeFile {
1.262 +package provide football 1.0
1.263 +
1.264 +namespace eval ::pro:: {
1.265 + #
1.266 + # export only public functions.
1.267 + #
1.268 + namespace export {[a-z]*}
1.269 +}
1.270 +namespace eval ::college:: {
1.271 + #
1.272 + # export only public functions.
1.273 + #
1.274 + namespace export {[a-z]*}
1.275 +}
1.276 +
1.277 +proc ::pro::team {} {
1.278 + puts "go packers!"
1.279 + return true
1.280 +}
1.281 +
1.282 +proc ::college::team {} {
1.283 + puts "go badgers!"
1.284 + return true
1.285 +}
1.286 +
1.287 +} [file join pkg samename.tcl]
1.288 +
1.289 +
1.290 +test autoMkindex-4.1 {platform indenpendant source commands} {
1.291 + file delete tclIndex
1.292 + auto_mkindex . pkg/samename.tcl
1.293 + set f [open tclIndex r]
1.294 + set dat [split [string trim [read $f]] "\n"]
1.295 + set len [llength $dat]
1.296 + set result [lsort [lrange $dat [expr {$len-2}] [expr {$len-1}]]]
1.297 + close $f
1.298 + set result
1.299 +} {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}}
1.300 +
1.301 +removeFile [file join pkg samename.tcl]
1.302 +
1.303 +makeFile {
1.304 +set dollar1 "this string contains an unescaped dollar sign -> \\$foo"
1.305 +set dollar2 "this string contains an escaped dollar sign -> \$foo \\\$foo"
1.306 +set bracket1 "this contains an unescaped bracket [NoSuchProc]"
1.307 +set bracket2 "this contains an escaped bracket \[NoSuchProc\]"
1.308 +set bracket3 "this contains nested unescaped brackets [[NoSuchProc]]"
1.309 +proc testProc {} {}
1.310 +} [file join pkg magicchar.tcl]
1.311 +
1.312 +test autoMkindex-5.1 {escape magic tcl chars in general code} {
1.313 + file delete tclIndex
1.314 + set result {}
1.315 + if { ![catch {auto_mkindex . pkg/magicchar.tcl}] } {
1.316 + set f [open tclIndex r]
1.317 + set dat [split [string trim [read $f]] "\n"]
1.318 + set result [lindex $dat end]
1.319 + close $f
1.320 + }
1.321 + set result
1.322 +} {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]}
1.323 +
1.324 +removeFile [file join pkg magicchar.tcl]
1.325 +
1.326 +makeFile {
1.327 +proc {[magic mojo proc]} {} {}
1.328 +} [file join pkg magicchar2.tcl]
1.329 +
1.330 +test autoMkindex-5.2 {correctly locate auto loaded procs with []} {
1.331 + file delete tclIndex
1.332 + set result {}
1.333 + if { ![catch {auto_mkindex . pkg/magicchar2.tcl}] } {
1.334 + # Make a slave interp to test the autoloading
1.335 + set c [interp create]
1.336 + $c eval {lappend auto_path [pwd]}
1.337 + set result [$c eval {catch {{[magic mojo proc]}}}]
1.338 + interp delete $c
1.339 + }
1.340 + set result
1.341 +} 0
1.342 +
1.343 +removeFile [file join pkg magicchar2.tcl]
1.344 +removeDirectory pkg
1.345 +
1.346 +# Clean up.
1.347 +
1.348 +unset result
1.349 +AutoMkindexTestReset
1.350 +if {[info exists saveCommands]} {
1.351 + unset saveCommands
1.352 +}
1.353 +rename AutoMkindexTestReset ""
1.354 +
1.355 +removeFile autoMkindex.tcl
1.356 +if {[file exists tclIndex]} {
1.357 + file delete -force tclIndex
1.358 +}
1.359 +
1.360 +cd $origDir
1.361 +
1.362 +::tcltest::cleanupTests