summaryrefslogtreecommitdiffstats
path: root/tests/autoMkindex.test
blob: 4be6beec3d633d318b4d8ba944c0ec2451341253 (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.11 2000/04/10 17:18:57 ericm 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} {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} {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