Tcl Source Code

Check-in [436735f3af]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:merge 8.7
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:436735f3af19e7439c560cb2f1ec342f46a45d04633d3ad913ca71e2f2601bb2
User & Date: sebres 2019-04-11 12:53:20
Context
2019-04-11
20:38
Merge 8.7 check-in: c8a7a0b2d8 user: jan.nijtmans tags: trunk
12:53
merge 8.7 check-in: 436735f3af user: sebres tags: trunk
09:52
merge 8.6 (conflicts resolved, changes on tests/cmdMZ.test in [4cb9044dfa] reverted - timerate is su... check-in: 1803c5e40f user: sebres tags: core-8-branch
2019-04-09
08:46
Merge 8.7 check-in: 6742cac017 user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to doc/define.n.

280
281
282
283
284
285
286
287

288
289
290
291
292
293
294
...
306
307
308
309
310
311
312
313

314
315
316
317
318
319
320
...
432
433
434
435
436
437
438
439

440

441
442
443
444
445
446
447
...
451
452
453
454
455
456
457
458


459
460
461
462
463
464
465
466
.VE TIP524
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR?
.
This deletes each of the methods called \fIname\fR from a class. The methods
must have previously existed in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified).

.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether
method call to instances of the class may be called and what the method's
results are. Each \fImethodName\fR names a single filtering method (which may
................................................................................
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
method must have previously existed in the class, and \fItoName\fR must not
previously refer to a method in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified). Does

not change the export status of the method; if it was exported before, it will
be afterwards.
.SH "CONFIGURING OBJECTS"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
form:
................................................................................
This allows the class of an object to be changed after creation. Note that the
class's constructors are not called when this is done, and so the object may
well be in an inconsistent state unless additional configuration work is done.
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR
.
This deletes each of the methods called \fIname\fR from an object. The methods
must have previously existed in that object. Does not affect the classes that

the object is an instance of.

.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether a
method call to the object may be called and what the method's results are.
Each \fImethodName\fR names a single filtering method (which may be exposed or
................................................................................
By default, this slot works by appending.
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
that the object is an instance of. Does not change the export status of the


method; if it was exported before, it will be afterwards.
.TP
\fBself \fR
.VS TIP470
This gives the name of the object currently being configured.
.VE TIP470
.SH "PRIVATE METHODS"
.VS TIP500






|
>







 







|
>







 







|
>
|
>







 







|
>
>
|







280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
...
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
...
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
...
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
.VE TIP524
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR?
.
This deletes each of the methods called \fIname\fR from a class. The methods
must have previously existed in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified) or the
class object itself.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether
method call to instances of the class may be called and what the method's
results are. Each \fImethodName\fR names a single filtering method (which may
................................................................................
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
method must have previously existed in the class, and \fItoName\fR must not
previously refer to a method in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified), or the
class object itself. Does
not change the export status of the method; if it was exported before, it will
be afterwards.
.SH "CONFIGURING OBJECTS"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
form:
................................................................................
This allows the class of an object to be changed after creation. Note that the
class's constructors are not called when this is done, and so the object may
well be in an inconsistent state unless additional configuration work is done.
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR
.
This deletes each of the methods called \fIname\fR from an object. The methods
must have previously existed in that object (e.g., because it was created
through \fBoo::objdefine method\fR). Does not affect the classes that the
object is an instance of, or remove the exposure of those class-provided
methods in the instance of that class.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether a
method call to the object may be called and what the method's results are.
Each \fImethodName\fR names a single filtering method (which may be exposed or
................................................................................
By default, this slot works by appending.
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
that the object is an instance of and cannot rename in an instance object the
methods provided by those classes (though a \fBoo::objdefine forward\fRed
method may provide an equivalent capability). Does not change the export
status of the method; if it was exported before, it will be afterwards.
.TP
\fBself \fR
.VS TIP470
This gives the name of the object currently being configured.
.VE TIP470
.SH "PRIVATE METHODS"
.VS TIP500

Changes to tests/cmdMZ.test.

311
312
313
314
315
316
317








318
319
320
321
322
323
324
...
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
...
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
...
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
    # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq"
    split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e"
} "a b qw\u5e4eN wq"

# The tests for Tcl_StringObjCmd are in string.test
# The tests for Tcl_SubstObjCmd are in subst.test
# The tests for Tcl_SwitchObjCmd are in switch.test









test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body {
    time
} -returnCodes error -result {wrong # args: should be "time command ?count?"}
test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} -body {
    time a b c
} -returnCodes error -result {wrong # args: should be "time command ?count?"}
................................................................................
test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} {
    time bogusCmd -12456
} {0 microseconds per iteration}
test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body {
    time {format 1}
} -match regexp -result {^\d+ microseconds per iteration}
test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} {
    expr {[lindex [time {after 2}] 0] < [lindex [time {after 1000}] 0]}
} 1
test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} {
    list [catch {time {error foo}} msg] $msg $::errorInfo
} {1 foo {foo
    while executing
"error foo"
    invoked from within
................................................................................
test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} {
    regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? nett-ms$} [timerate {} 0]
} 1
test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} {
    regexp {^0 \ws/# 0 # 0 #/sec 0 nett-ms$} [timerate {} 0 0]
} 1
test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} {
    set m1 [timerate {after 0} 20]
    set m2 [timerate {after 1} 20]
    list \
	[expr {[lindex $m1 0] < [lindex $m2 0]}] \
	[expr {[lindex $m1 0] < 100}] \
	[expr {[lindex $m2 0] >= 500}] \
	[expr {[lindex $m1 2] > 1000}] \
	[expr {[lindex $m2 2] <= 50}] \
	[expr {[lindex $m1 4] > 10000}] \
	[expr {[lindex $m2 4] < 10000}] \
	[expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 50}] \
	[expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 50}]
} [lrepeat 9 1]
test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} {
    list [catch {timerate {error foo} 1} msg] $msg $::errorInfo
} {1 foo {foo
    while executing
"error foo"
    invoked from within
................................................................................
	[expr {[lindex $m1 0] < 1000}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] > 1000}] \
	[expr {[lindex $m1 6] < 10}]
} {1 1 1 1}
test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} {
    set m1 [timerate {} 1000 5];	# max-count wins
    set m2 [timerate {after 20} 1 5];	# max-time wins
    list [lindex $m1 2] [lindex $m2 2]
} {5 1}
test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} {
    set m1 [timerate -overhead 1e6 {after 10} 100 1]
    list \
	[expr {[lindex $m1 0] == 0.0}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] == 1000000}] \
	[expr {[lindex $m1 6] <= 0.001}]
} {1 1 1 1}







>
>
>
>
>
>
>
>







 







|







 







|
|



|

|
|
|
|
|







 







|



|







311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
...
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
...
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
...
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
    # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq"
    split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e"
} "a b qw\u5e4eN wq"

# The tests for Tcl_StringObjCmd are in string.test
# The tests for Tcl_SubstObjCmd are in subst.test
# The tests for Tcl_SwitchObjCmd are in switch.test

# todo: rewrite this if monotonic clock is provided resp. command "after" 
# gets microsecond accuracy (RFE [fdfbd5e10] gets merged):
proc _nrt_sleep {msec} {
    set usec [expr {$msec * 1000}]
    set stime [clock microseconds]
    while {abs([clock microseconds] - $stime) < $usec} {after 0}
}

test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body {
    time
} -returnCodes error -result {wrong # args: should be "time command ?count?"}
test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} -body {
    time a b c
} -returnCodes error -result {wrong # args: should be "time command ?count?"}
................................................................................
test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} {
    time bogusCmd -12456
} {0 microseconds per iteration}
test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body {
    time {format 1}
} -match regexp -result {^\d+ microseconds per iteration}
test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} {
    expr {[lindex [time {_nrt_sleep 1}] 0] < [lindex [time {_nrt_sleep 20}] 0]}
} 1
test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} {
    list [catch {time {error foo}} msg] $msg $::errorInfo
} {1 foo {foo
    while executing
"error foo"
    invoked from within
................................................................................
test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} {
    regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? nett-ms$} [timerate {} 0]
} 1
test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} {
    regexp {^0 \ws/# 0 # 0 #/sec 0 nett-ms$} [timerate {} 0 0]
} 1
test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} {
    set m1 [timerate {_nrt_sleep 0} 20]
    set m2 [timerate {_nrt_sleep 0.2} 20]
    list \
	[expr {[lindex $m1 0] < [lindex $m2 0]}] \
	[expr {[lindex $m1 0] < 100}] \
	[expr {[lindex $m2 0] > 100}] \
	[expr {[lindex $m1 2] > 1000}] \
	[expr {[lindex $m2 2] < 1000}] \
	[expr {[lindex $m1 4] > 50000}] \
	[expr {[lindex $m2 4] < 50000}] \
	[expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 100}] \
	[expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 100}]
} [lrepeat 9 1]
test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} {
    list [catch {timerate {error foo} 1} msg] $msg $::errorInfo
} {1 foo {foo
    while executing
"error foo"
    invoked from within
................................................................................
	[expr {[lindex $m1 0] < 1000}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] > 1000}] \
	[expr {[lindex $m1 6] < 10}]
} {1 1 1 1}
test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} {
    set m1 [timerate {} 1000 5];	# max-count wins
    set m2 [timerate {_nrt_sleep 20} 1 5];	# max-time wins
    list [lindex $m1 2] [lindex $m2 2]
} {5 1}
test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} {
    set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1]
    list \
	[expr {[lindex $m1 0] == 0.0}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] == 1000000}] \
	[expr {[lindex $m1 6] <= 0.001}]
} {1 1 1 1}

Changes to tests/oo.test.

1544
1545
1546
1547
1548
1549
1550
























1551
1552
1553
1554
1555
1556
1557
    lappend result [C a] [C b] [C c] -
    oo::define B deletemethod b
    lappend result [C a] [C b] [C c] -
    oo::define B renamemethod a b
    lappend result [C a] [C b] [C c] -
    oo::define B deletemethod b c
    lappend result [C a] [C b] [C c]
























} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}

test oo-11.1 {OO: cleanup} {
    oo::object create foo
    set result [list [catch {oo::object create foo} msg] $msg]
    lappend result [foo destroy] [oo::object create foo] [foo destroy]
} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}






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







1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
    lappend result [C a] [C b] [C c] -
    oo::define B deletemethod b
    lappend result [C a] [C b] [C c] -
    oo::define B renamemethod a b
    lappend result [C a] [C b] [C c] -
    oo::define B deletemethod b c
    lappend result [C a] [C b] [C c]
} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}
test oo-10.4 {OO: invoke and modify} -setup {
    oo::class create A {
	method a {} {return A.a}
	method b {} {return A.b}
	method c {} {return A.c}
    }
    A create B
    oo::objdefine B {
	method a {} {return [next],B.a}
	method b {} {return [next],B.b}
	method c {} {return [next],B.c}
    }
    set result {}
} -cleanup {
    A destroy
} -body {
    lappend result [B a] [B b] [B c] -
    oo::objdefine B deletemethod b
    lappend result [B a] [B b] [B c] -
    oo::objdefine B renamemethod a b
    lappend result [B a] [B b] [B c] -
    oo::objdefine B deletemethod b c
    lappend result [B a] [B b] [B c]
} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}

test oo-11.1 {OO: cleanup} {
    oo::object create foo
    set result [list [catch {oo::object create foo} msg] $msg]
    lappend result [foo destroy] [oo::object create foo] [foo destroy]
} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}