1# Commands covered: auto_mkindex auto_import 2# 3# This file contains tests related to autoloading and generating the 4# autoloading index. 5# 6# Copyright © 1998 Lucent Technologies, Inc. 7# Copyright © 1998-1999 Scriptics Corporation. 8# 9# See the file "license.terms" for information on usage and redistribution of 10# this file, and for a DISCLAIMER OF ALL WARRANTIES. 11 12if {"::tcltest" ni [namespace children]} { 13 package require tcltest 2.5 14 namespace import -force ::tcltest::* 15} 16 17makeFile {# Test file for: 18# auto_mkindex 19# 20# This file provides example cases for testing the Tcl autoloading facility. 21# Things are much more complicated with namespaces and classes. The 22# "auto_mkindex" facility can no longer be built on top of a simple regular 23# expression parser. It must recognize constructs like this: 24# 25# namespace eval foo { 26# proc test {x y} { ... } 27# namespace eval bar { 28# proc another {args} { ... } 29# } 30# } 31# 32# Note that procedures and itcl class definitions can be nested inside of 33# namespaces. 34# 35# Copyright © 1993-1998 Lucent Technologies, Inc. 36 37# This shouldn't cause any problems 38namespace import -force blt::* 39 40# Should be able to handle "proc" definitions, even if they are preceded by 41# white space. 42 43proc normal {x y} {return [expr {$x+$y}]} 44 proc indented {x y} {return [expr {$x+$y}]} 45 46# 47# Should be able to handle proc declarations within namespaces, even if they 48# have explicit namespace paths. 49# 50namespace eval buried { 51 proc inside {args} {return "inside: $args"} 52 53 namespace export pub_* 54 proc pub_one {args} {return "one: $args"} 55 proc pub_two {args} {return "two: $args"} 56} 57proc buried::within {args} {return "within: $args"} 58 59namespace eval buried { 60 namespace eval under { 61 proc neath {args} {return "neath: $args"} 62 } 63 namespace eval ::buried { 64 proc relative {args} {return "relative: $args"} 65 proc ::top {args} {return "top: $args"} 66 proc ::buried::explicit {args} {return "explicit: $args"} 67 } 68} 69 70# With proper hooks, we should be able to support other commands that create 71# procedures 72 73proc buried::myproc {name body args} { 74 ::proc $name $body $args 75} 76namespace eval ::buried { 77 proc mycmd1 args {return "mycmd"} 78 myproc mycmd2 args {return "mycmd"} 79} 80::buried::myproc mycmd3 args {return "another"} 81 82proc {buried::my proc} {name body args} { 83 ::proc $name $body $args 84} 85namespace eval ::buried { 86 proc mycmd4 args {return "mycmd"} 87 {my proc} mycmd5 args {return "mycmd"} 88} 89{::buried::my proc} mycmd6 args {return "another"} 90 91# A correctly functioning [auto_import] won't choke when a child namespace 92# [namespace import]s from its parent. 93# 94namespace eval ::parent::child { 95 namespace import ::parent::* 96} 97proc ::parent::child::test {} {} 98} autoMkindex.tcl 99 100# Save initial state of auto_mkindex_parser 101 102auto_load auto_mkindex 103if {[info exists auto_mkindex_parser::initCommands]} { 104 set saveCommands $auto_mkindex_parser::initCommands 105} 106proc AutoMkindexTestReset {} { 107 global saveCommands 108 if {[info exists saveCommands]} { 109 set auto_mkindex_parser::initCommands $saveCommands 110 } elseif {[info exists auto_mkindex_parser::initCommands]} { 111 unset auto_mkindex_parser::initCommands 112 } 113} 114 115set result "" 116 117set origDir [pwd] 118cd $::tcltest::temporaryDirectory 119 120test autoMkindex-1.1 {remove any existing tclIndex file} { 121 file delete tclIndex 122 file exists tclIndex 123} {0} 124test autoMkindex-1.2 {build tclIndex based on a test file} { 125 auto_mkindex . autoMkindex.tcl 126 file exists tclIndex 127} {1} 128set element "{source [file join . autoMkindex.tcl]}" 129test autoMkindex-1.3 {examine tclIndex} -setup { 130 file delete tclIndex 131} -body { 132 auto_mkindex . autoMkindex.tcl 133 namespace eval tcl_autoMkindex_tmp { 134 set dir "." 135 variable auto_index 136 source tclIndex 137 set ::result "" 138 foreach elem [lsort [array names auto_index]] { 139 lappend ::result [list $elem $auto_index($elem)] 140 } 141 } 142 return $result 143} -cleanup { 144 namespace delete tcl_autoMkindex_tmp 145} -result "{::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}" 146 147test autoMkindex-2.1 {commands on the autoload path can be imported} -setup { 148 file delete tclIndex 149 interp create child 150} -body { 151 auto_mkindex . autoMkindex.tcl 152 child eval { 153 namespace eval blt {} 154 set auto_path [linsert $auto_path 0 .] 155 set info [list [catch {namespace import buried::*} result] $result] 156 foreach name [lsort [info commands pub_*]] { 157 lappend info $name [namespace origin $name] 158 } 159 return $info 160 } 161} -cleanup { 162 interp delete child 163} -result "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two" 164 165# Test auto_mkindex hooks 166 167# Child hook executes interesting code in the interp used to watch code. 168test autoMkindex-3.1 {childHook} -setup { 169 file delete tclIndex 170} -body { 171 auto_mkindex_parser::childhook { 172 _%@namespace eval ::blt { 173 proc foo {} {} 174 _%@namespace export foo 175 } 176 } 177 auto_mkindex_parser::childhook { _%@namespace import -force ::blt::* } 178 auto_mkindex . autoMkindex.tcl 179 file exists tclIndex 180} -cleanup { 181 # Reset initCommands to avoid trashing other tests 182 AutoMkindexTestReset 183} -result 1 184# The auto_mkindex_parser::command is used to register commands that create 185# new commands. 186test autoMkindex-3.2 {auto_mkindex_parser::command} -setup { 187 file delete tclIndex 188} -body { 189 auto_mkindex_parser::command buried::myproc {name args} { 190 variable index 191 variable scriptFile 192 append index [list set auto_index([fullname $name])] \ 193 " \[list source \[file join \$dir [list $scriptFile]\]\]\n" 194 } 195 auto_mkindex . autoMkindex.tcl 196 namespace eval tcl_autoMkindex_tmp { 197 set dir "." 198 variable auto_index 199 source tclIndex 200 set ::result "" 201 foreach elem [lsort [array names auto_index]] { 202 lappend ::result [list $elem $auto_index($elem)] 203 } 204 return $::result 205 } 206} -cleanup { 207 namespace delete tcl_autoMkindex_tmp 208 # Reset initCommands to avoid trashing other tests 209 AutoMkindexTestReset 210} -result "{::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}" 211test autoMkindex-3.3 {auto_mkindex_parser::command} -setup { 212 file delete tclIndex 213} -constraints {knownBug} -body { 214 auto_mkindex_parser::command {buried::my proc} {name args} { 215 variable index 216 variable scriptFile 217 puts "my proc $name" 218 append index [list set auto_index([fullname $name])] \ 219 " \[list source \[file join \$dir [list $scriptFile]\]\]\n" 220 } 221 auto_mkindex . autoMkindex.tcl 222 namespace eval tcl_autoMkindex_tmp { 223 set dir "." 224 variable auto_index 225 source tclIndex 226 set ::result "" 227 foreach elem [lsort [array names auto_index]] { 228 lappend ::result [list $elem $auto_index($elem)] 229 } 230 } 231 list [lsearch -inline $::result *mycmd4*] \ 232 [lsearch -inline $::result *mycmd5*] \ 233 [lsearch -inline $::result *mycmd6*] 234} -cleanup { 235 namespace delete tcl_autoMkindex_tmp 236 # Reset initCommands to avoid trashing other tests 237 AutoMkindexTestReset 238} -result "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}" 239makeFile { 240 241namespace eval wok { 242 namespace ensemble create -subcommands {commands vars} 243 244 proc commands {{pattern *}} { 245 puts [join [lsort -dictionary [info commands $pattern]] \n] 246 } 247 248 proc vars {{pattern *}} { 249 puts [join [lsort -dictionary [info vars $pattern]] \n] 250 } 251 252} 253 254} ensemblecommands.tcl 255 256test autoMkindex-3.4 {ensemble commands in tclIndex} { 257 file delete tclIndex 258 auto_mkindex . ensemblecommands.tcl 259 set f [open tclIndex r] 260 set dat [list] 261 foreach r [split [string trim [read $f]] "\n"] { 262 if {[string match {set auto_index*} $r]} { 263 lappend dat $r 264 } 265 } 266 set result [lsort $dat] 267 close $f 268 set result 269} {{set auto_index(::wok::commands) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(::wok::vars) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(wok) [list source [file join $dir ensemblecommands.tcl]]}} 270removeFile ensemblecommands.tcl 271 272test autoMkindex-4.1 {platform independent source commands} -setup { 273 file delete tclIndex 274 makeDirectory pkg 275 makeFile { 276 package provide football 1.0 277 namespace eval ::pro:: { 278 # 279 # export only public functions. 280 # 281 namespace export {[a-z]*} 282 } 283 namespace eval ::college:: { 284 # 285 # export only public functions. 286 # 287 namespace export {[a-z]*} 288 } 289 proc ::pro::team {} { 290 puts "go packers!" 291 return true 292 } 293 proc ::college::team {} { 294 puts "go badgers!" 295 return true 296 } 297 } [file join pkg samename.tcl] 298} -body { 299 auto_mkindex . pkg/samename.tcl 300 set f [open tclIndex r] 301 lsort [lrange [split [string trim [read $f]] "\n"] end-1 end] 302} -cleanup { 303 catch {close $f} 304 removeFile [file join pkg samename.tcl] 305 removeDirectory pkg 306} -result {{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]]}} 307 308test autoMkindex-5.1 {escape magic tcl chars in general code} -setup { 309 file delete tclIndex 310 makeDirectory pkg 311 makeFile { 312 set dollar1 "this string contains an unescaped dollar sign -> \\$foo" 313 set dollar2 \ 314 "this string contains an escaped dollar sign -> \$foo \\\$foo" 315 set bracket1 "this contains an unescaped bracket [NoSuchProc]" 316 set bracket2 "this contains an escaped bracket \[NoSuchProc\]" 317 set bracket3 \ 318 "this contains nested unescaped brackets [[NoSuchProc]]" 319 proc testProc {} {} 320 } [file join pkg magicchar.tcl] 321 set result {} 322} -body { 323 auto_mkindex . pkg/magicchar.tcl 324 set f [open tclIndex r] 325 lindex [split [string trim [read $f]] "\n"] end 326} -cleanup { 327 catch {close $f} 328 removeFile [file join pkg magicchar.tcl] 329 removeDirectory pkg 330} -result {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]} 331test autoMkindex-5.2 {correctly locate auto loaded procs with []} -setup { 332 file delete tclIndex 333 makeDirectory pkg 334 makeFile { 335 proc {[magic mojo proc]} {} {} 336 } [file join pkg magicchar2.tcl] 337 set result {} 338 interp create child 339} -body { 340 auto_mkindex . pkg/magicchar2.tcl 341 # Make a child interp to test the autoloading 342 child eval {lappend auto_path [pwd]} 343 child eval {catch {{[magic mojo proc]}}} 344} -cleanup { 345 interp delete child 346 removeFile [file join pkg magicchar2.tcl] 347 removeDirectory pkg 348} -result 0 349 350# Clean up. 351 352unset result 353AutoMkindexTestReset 354if {[info exists saveCommands]} { 355 unset saveCommands 356} 357rename AutoMkindexTestReset "" 358 359removeFile autoMkindex.tcl 360if {[file exists tclIndex]} { 361 file delete -force tclIndex 362} 363 364cd $origDir 365 366::tcltest::cleanupTests 367return 368 369# Local Variables: 370# mode: tcl 371# fill-column: 78 372# End: 373