Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | [1ae12987cb] Ensure that deleting the [history] command deletes its storage. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | core-8-6-branch |
| Files: | files | file ages | folders |
| SHA1: |
3135d5681f5949c88c56b32ef27a304d |
| User & Date: | dkf 2016-10-30 08:22:13 |
Context
|
2016-10-30
| ||
| 16:16 | [253ba6e818] Improved description of [variable] behaviour. check-in: 6abd304ca2 user: dkf tags: core-8-6-branch | |
| 08:31 | [1ae12987cb] Ensure that deleting the [history] command deletes its storage. check-in: eb11bf9cb5 user: dkf tags: trunk | |
| 08:22 | [1ae12987cb] Ensure that deleting the [history] command deletes its storage. check-in: 3135d5681f user: dkf tags: core-8-6-branch | |
| 05:07 | One more place where the internal API change can be used easily. check-in: 77e725f099 user: dkf tags: core-8-6-branch | |
Changes
Changes to library/history.tcl.
51 52 53 54 55 56 57 58 59 60 61 62 63 64 |
if {![llength $args]} {
set args info
}
# Tricky stuff needed to make stack and errors come out right!
tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
}
# tcl::HistAdd --
#
# Add an item to the history, and optionally eval it at the global scope
#
# Parameters:
# event the command to add
|
> > > > > > > > > > > > > > > > > > > > > > > > |
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 |
if {![llength $args]} {
set args info
}
# Tricky stuff needed to make stack and errors come out right!
tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
}
# (unnamed) --
#
# Callback when [::history] is destroyed. Destroys the implementation.
#
# Parameters:
# oldName what the command was called.
# newName what the command is now called (an empty string).
# op the operation (= delete).
#
# Results:
# none
#
# Side Effects:
# The implementation of the [::history] command ceases to exist.
trace add command ::history delete [list apply {{oldName newName op} {
variable history
unset -nocomplain history
foreach c [info procs ::tcl::Hist*] {
rename $c {}
}
rename ::tcl::history {}
} ::tcl}]
# tcl::HistAdd --
#
# Add an item to the history, and optionally eval it at the global scope
#
# Parameters:
# event the command to add
|
Changes to tests/history.test.
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, 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.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
# The history command might be autoloaded...
if {[catch {history}]} {
testConstraint history 0
} else {
................................................................................
# miscellaneous
test history-9.1 {miscellaneous} history {catch {history gorp} msg} 1
test history-9.2 {miscellaneous} history {
catch {history gorp} msg
set msg
} {unknown or ambiguous subcommand "gorp": must be add, change, clear, event, info, keep, nextid, or redo}
# cleanup
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
|
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, 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.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
}
# The history command might be autoloaded...
if {[catch {history}]} {
testConstraint history 0
} else {
................................................................................
# miscellaneous
test history-9.1 {miscellaneous} history {catch {history gorp} msg} 1
test history-9.2 {miscellaneous} history {
catch {history gorp} msg
set msg
} {unknown or ambiguous subcommand "gorp": must be add, change, clear, event, info, keep, nextid, or redo}
# History retains references; Bug 1ae12987cb
test history-10.1 {references kept by history} -constraints history -setup {
interp create histtest
histtest eval {
# Trigger any autoloading that might be present
catch {history}
proc refcount {x} {
set rep [::tcl::unsupported::representation $x]
regexp {with a refcount of (\d+)} $rep -> rc
# Ignore the references due to calling this procedure
return [expr {$rc - 3}]
}
}
} -body {
histtest eval {
# A fresh object, refcount 1 from the variable we write it to
set obj [expr rand()]
set baseline [refcount $obj]
lappend result [refcount $obj]
history add [list list $obj]
lappend result [refcount $obj]
history clear
lappend result [refcount $obj]
}
} -cleanup {
interp delete histtest
} -result {1 2 1}
test history-10.2 {references kept by history} -constraints history -setup {
interp create histtest
histtest eval {
# Trigger any autoloading that might be present
catch {history}
proc refcount {x} {
set rep [::tcl::unsupported::representation $x]
regexp {with a refcount of (\d+)} $rep -> rc
# Ignore the references due to calling this procedure
return [expr {$rc - 3}]
}
}
} -body {
histtest eval {
# A fresh object, refcount 1 from the variable we write it to
set obj [expr rand()]
set baseline [refcount $obj]
lappend result [refcount $obj]
history add [list list $obj]
lappend result [refcount $obj]
rename history {}
lappend result [refcount $obj]
}
} -cleanup {
interp delete histtest
} -result {1 2 1}
# cleanup
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|