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 |
Timelines: | family | ancestors | descendants | both | core-8-1-branch-old |
Files: | files | file ages | folders |
SHA1: |
f33978ea19b5810d2d2928811c7811cd |
User & Date: | welch 1999-03-31 19:54:25.000 |
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
Changes to tests/autoMkindex.tcl.
︙ | ︙ | |||
47 48 49 50 51 52 53 | 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.
1 2 3 4 5 6 7 8 9 10 11 | # 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. # | | > > > > > > > > > > > > > > > > > > > | | < > > | < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > | > < < < < < < < < < < < < | 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 | # 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.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 |