blob: 77c4d800ef16619b2e72407b24085f259d870595 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
# Commands covered: auto_mkindex auto_import
#
# This file contains tests related to autoloading and generating
# the autoloading index.
#
# Copyright (c) 1998 Lucent Technologies, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: autoMkindex.test,v 1.12 2001/05/03 22:38:20 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
# temporarily copy the autoMkindex.tcl file from testsDirectory to
# temporaryDirectory
set origMkindexFile [file join $::tcltest::testsDirectory autoMkindex.tcl]
set newMkindexFile [file join $::tcltest::temporaryDirectory autoMkindex.tcl]
if {![catch {file copy $origMkindexFile $newMkindexFile}]} {
set removeAutoMkindex 1
}
# Save initial state of auto_mkindex_parser
auto_load auto_mkindex
if {[info exist auto_mkindex_parser::initCommands]} {
set saveCommands $auto_mkindex_parser::initCommands
}
proc AutoMkindexTestReset {} {
global saveCommands
if {[info exist saveCommands]} {
set auto_mkindex_parser::initCommands $saveCommands
} elseif {[info exist auto_mkindex_parser::initCommands]} {
unset auto_mkindex_parser::initCommands
}
}
set result ""
set origDir [pwd]
cd $::tcltest::testsDirectory
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} {
file delete tclIndex
auto_mkindex . autoMkindex.tcl
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)]
}
}
namespace delete tcl_autoMkindex_tmp
set ::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}"
test autoMkindex-2.1 {commands on the autoload path can be imported} {
file delete tclIndex
auto_mkindex . autoMkindex.tcl
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"
# Test auto_mkindex hooks
# Slave hook executes interesting code in the interp used to watch code.
test autoMkindex-3.1 {slaveHook} {
auto_mkindex_parser::slavehook {
_%@namespace eval ::blt {
proc foo {} {}
_%@namespace export foo
}
}
auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* }
file delete tclIndex
auto_mkindex . autoMkindex.tcl
# Reset initCommands to avoid trashing other tests
AutoMkindexTestReset
file exists tclIndex
} 1
# The auto_mkindex_parser::command is used to register commands
# that create new commands.
test autoMkindex-3.2 {auto_mkindex_parser::command} {
auto_mkindex_parser::command buried::myproc {name args} {
variable index
variable scriptFile
append index [list set auto_index([fullname $name])] \
" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
}
file delete tclIndex
auto_mkindex . autoMkindex.tcl
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)]
}
}
namespace delete tcl_autoMkindex_tmp
# Reset initCommands to avoid trashing other tests
AutoMkindexTestReset
set ::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}"
test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
auto_mkindex_parser::command {buried::my proc} {name args} {
variable index
variable scriptFile
puts "my proc $name"
append index [list set auto_index([fullname $name])] \
" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
}
file delete tclIndex
auto_mkindex . autoMkindex.tcl
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)]
}
}
namespace delete tcl_autoMkindex_tmp
# Reset initCommands to avoid trashing other tests
AutoMkindexTestReset
proc lvalue {list pattern} {
set ix [lsearch $list $pattern]
if {$ix >= 0} {
return [lindex $list $ix]
} else {
return {}
}
}
list [lvalue $::result *mycmd4*] [lvalue $::result *mycmd5*] [lvalue $::result *mycmd6*]
} "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"
test autoMkindex-4.1 {platform indenpendant source commands} {
file delete tclIndex
auto_mkindex . pkg/samename.tcl
set f [open tclIndex r]
set dat [split [string trim [read $f]] "\n"]
set len [llength $dat]
set result [lsort [lrange $dat [expr {$len-2}] [expr {$len-1}]]]
close $f
set 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]]}}
test autoMkindex-5.1 {escape magic tcl chars in general code} {
file delete tclIndex
set result {}
if { ![catch {auto_mkindex . pkg/magicchar.tcl}] } {
set f [open tclIndex r]
set dat [split [string trim [read $f]] "\n"]
set result [lindex $dat end]
close $f
}
set result
} {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]}
test autoMkindex-5.2 {correctly locate auto loaded procs with []} {
file delete tclIndex
set res {}
if { ![catch {auto_mkindex . pkg/magicchar2.tcl}] } {
# Make a slave interp to test the autoloading
set c [interp create]
$c eval {lappend auto_path [pwd]}
set res [$c eval {catch {{[magic mojo proc]}}}]
interp delete $c
}
set res
} 0
# Clean up.
unset result
AutoMkindexTestReset
if {[info exist saveCommands]} {
unset saveCommands
}
rename AutoMkindexTestReset ""
if {[info exists removeAutoMkindex]} {
catch {file delete $newMkindexFile}
}
if {[file exists tclIndex]} {
file delete -force tclIndex
}
cd $origDir
::tcltest::cleanupTests
|
