Tcl Source Code

Check-in [84e29e7149]
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:closes [1e5e25cf2b] - tests/cmdMZ.test: fixed NRT-related sleeps (and time-related corner cases and test expectations); todo: rewrite several tests if monotonic clock is provided resp. command "after" gets microsecond accuracy (RFE [fdfbd5e10] gets merged)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA3-256: 84e29e7149de257ebdc290876354a5bf46ae4e7f5463a7d415c3232a4430c735
User & Date: sebres 2019-04-09 10:31:36
References
2019-04-09
10:35 Closed ticket [1e5e25cf2b]: valgrind foils timerate expectations plus 7 other changes artifact: 88b5172e72 user: sebres
Context
2019-04-09
19:37
closes [940ce8f958] - tests/cmdMZ.test: avoid import timerate to global NS in tests (e. g. using tcl... check-in: 242fe24b35 user: sebres tags: core-8-5-branch
10:33
merge 8.5 check-in: 318588076e user: sebres tags: core-8-6-branch
10:31
closes [1e5e25cf2b] - tests/cmdMZ.test: fixed NRT-related sleeps (and time-related corner cases and ... check-in: 84e29e7149 user: sebres tags: core-8-5-branch
2019-04-08
19:31
Add test-cases for win32/win64 --disable-shared, and put standard --enable-threads check-in: 2398513042 user: jan.nijtmans tags: core-8-5-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/cmdMZ.test.

316
317
318
319
320
321
322








323
324
325
326
327
328
329
...
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
...
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
...
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
    # 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} {
    list [catch {time} msg] $msg
} {1 {wrong # args: should be "time command ?count?"}}
test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} {
    list [catch {time a b c} msg] $msg
} {1 {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} {
    regexp {^\d+ microseconds per iteration} [time {format 1}]
} 1
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}







>
>
>
>
>
>
>
>







 







|







 







|
|



|

|
|
|
|
|







 







|



|







316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
...
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
...
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
...
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
    # 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} {
    list [catch {time} msg] $msg
} {1 {wrong # args: should be "time command ?count?"}}
test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} {
    list [catch {time a b c} msg] $msg
} {1 {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} {
    regexp {^\d+ microseconds per iteration} [time {format 1}]
} 1
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}