Tcl Source Code

Check-in [f33978ea19]
Login
Core Home Timeline Branches Tags Tickets Wiki Clone or Download

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Tests for quoting bugs in auto_mkindex slavehook: BUGID 1657
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1:f33978ea19b5810d2d2928811c7811cd7ca04f00
User & Date: welch 1999-03-31 19:54:25
Context
1999-04-01
00:38
Added new bitmap for 8.1b3 and modified text in Finished panel. check-in: 8c3361f3a6 user: redman tags: core-8-1-branch-old
1999-03-31
19:54
Tests for quoting bugs in auto_mkindex slavehook: BUGID 1657 check-in: f33978ea19 user: welch tags: core-8-1-branch-old
19:54
Fixing quoting bugs in auto_mkindex slavehook: BUGID 1657 check-in: 293b4045fe user: welch tags: core-8-1-branch-old
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/autoMkindex.tcl. 

47
48
49
50
51
52
53


54


55



56

57


58



59
60
61
62
63


    namespace eval ::buried {
        proc relative {args} {return "relative: $args"}
        proc ::top {args} {return "top: $args"}
        proc ::buried::explicit {args} {return "explicit: $args"}
    }
}
































>
>

>
>
|
>
>
>
|
>

>
>
|
>
>
>
|
<
<
<
<
>

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

    namespace eval ::buried {
        proc relative {args} {return "relative: $args"}
        proc ::top {args} {return "top: $args"}
        proc ::buried::explicit {args} {return "explicit: $args"}
    }
}

# With proper hooks, we should be able to support other commands
# that create procedures

proc buried::myproc {name body args} {
    ::proc $name $body $args
}
namespace eval ::buried {
    proc mycmd1 args {return "mycmd"}
    myproc mycmd2 args {return "mycmd"}
}
::buried::myproc mycmd3 args {return "another"}

proc {buried::my proc} {name body args} {
    ::proc $name $body $args
}
namespace eval ::buried {
    proc mycmd4 args {return "mycmd"}
    {my proc} mycmd5 args {return "mycmd"}
}




{::buried::my proc} mycmd6 args {return "another"}

Changes to tests/autoMkindex.test. 

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


#
# 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.1.2.5 1999/03/24 02:48:57 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# temporarily copy the autoMkindex.tcl file from testsDir to tmpDir
set origMkindexFile [file join $::tcltest::testsDir autoMkindex.tcl]
set newMkindexFile [file join $::tcltest::workingDir autoMkindex.tcl]
if {![catch {file copy $origMkindexFile $newMkindexFile}]} {
    set removeAutoMkindex 1
}


















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"

# cleanup
















if {[info exists removeAutoMkindex]} {













    catch {file delete $newMkindexFile}








}























catch {file delete -force tclIndex}
::tcltest::cleanupTests












































|











>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>




|

|

<

>
|
>

<


>
>







 







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
>
>
>
|
|
>

>

>
>
>
>
>
>
>
|
|
>
>

>

>
>
>
>
|
>

>
>
|
>
>
|
>

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

#
# 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.1.2.6 1999/03/31 19:54:25 welch Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# temporarily copy the autoMkindex.tcl file from testsDir to tmpDir
set origMkindexFile [file join $::tcltest::testsDir autoMkindex.tcl]
set newMkindexFile [file join $::tcltest::workingDir 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 ""

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}"

# 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
}
::tcltest::cleanupTests

This page was generated in about 0.012s by Fossil 2.8 [5280c1ab9a] 2019-01-27 19:32:37