From ccbd8395f4a51f5b769998058006ed3d36823ace Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 23 May 2017 21:57:13 +0000 Subject: [win32] optimized calibration cycle (makes Tcl for windows "RTS" resp. NRT-capable): - the clock ticks never backwards (avoid it by negative drifts using comparison of times before and after calibration); - more precise, smooth/soft drifting (avoids too large drifts, already after 10 iterations the drift gets fewer as 0.1 microseconds); - because of more accurate drifting (aspire to the smallest difference), we can prolong calibration interval (up to 10 seconds by small tdiff-value); Closes ticket [b7b707a310ea42e9f1b29954ee8ca13ae91ccabe] "[win32] NRT-only - NativeGetTime backwards time-drifts bug" --- win/tclWinTime.c | 175 ++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 122 insertions(+), 53 deletions(-) diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 374c41c..93f62b8 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -51,6 +51,7 @@ typedef struct TimeInfo { * initialized. */ int perfCounterAvailable; /* Flag == 1 if the hardware has a performance * counter. */ + DWORD calibrationInterv; /* Calibration interval in seconds (start 1 sec) */ HANDLE calibrationThread; /* Handle to the thread that keeps the virtual * clock calibrated. */ HANDLE readyEvent; /* System event used to trigger the requesting @@ -61,7 +62,6 @@ typedef struct TimeInfo { LARGE_INTEGER nominalFreq; /* Nominal frequency of the system performance * counter, that is, the value returned from * QueryPerformanceFrequency. */ - /* * The following values are used for calculating virtual time. Virtual * time is always equal to: @@ -74,6 +74,8 @@ typedef struct TimeInfo { ULARGE_INTEGER fileTimeLastCall; LARGE_INTEGER perfCounterLastCall; LARGE_INTEGER curCounterFreq; + LARGE_INTEGER posixEpoch; /* Posix epoch expressed as 100-ns ticks since + * the windows epoch. */ /* * Data used in developing the estimate of performance counter frequency @@ -87,9 +89,10 @@ typedef struct TimeInfo { } TimeInfo; static TimeInfo timeInfo = { - { NULL }, + { NULL, 0, 0, NULL, NULL, 0 }, 0, 0, + 1, (HANDLE) NULL, (HANDLE) NULL, (HANDLE) NULL, @@ -98,11 +101,13 @@ static TimeInfo timeInfo = { (ULARGE_INTEGER) (DWORDLONG) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, + (LARGE_INTEGER) (Tcl_WideInt) 0, #else - 0, - 0, - 0, - 0, + {0, 0}, + {0, 0}, + {0, 0}, + {0, 0}, + {0, 0}, #endif { 0 }, { 0 }, @@ -464,12 +469,20 @@ NativeScaleTime( *---------------------------------------------------------------------- */ +static inline Tcl_WideInt +NativeCalc100NsTicks( + ULONGLONG fileTimeLastCall, + LONGLONG perfCounterLastCall, + LONGLONG curCounterFreq, + LONGLONG curCounter +) { + return fileTimeLastCall + + ((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq); +} + static Tcl_WideInt NativeGetMicroseconds(void) { - static LARGE_INTEGER posixEpoch; - /* Posix epoch expressed as 100-ns ticks since - * the windows epoch. */ /* * Initialize static storage on the first trip through. * @@ -481,8 +494,8 @@ NativeGetMicroseconds(void) TclpInitLock(); if (!timeInfo.initialized) { - posixEpoch.LowPart = 0xD53E8000; - posixEpoch.HighPart = 0x019DB1DE; + timeInfo.posixEpoch.LowPart = 0xD53E8000; + timeInfo.posixEpoch.HighPart = 0x019DB1DE; timeInfo.perfCounterAvailable = QueryPerformanceFrequency(&timeInfo.nominalFreq); @@ -588,16 +601,12 @@ NativeGetMicroseconds(void) * time. */ - ULARGE_INTEGER fileTimeLastCall; - LARGE_INTEGER perfCounterLastCall, curCounterFreq; + ULONGLONG fileTimeLastCall; + LONGLONG perfCounterLastCall, curCounterFreq; /* Copy with current data of calibration cycle */ LARGE_INTEGER curCounter; /* Current performance counter. */ - Tcl_WideInt curFileTime;/* Current estimated time, expressed as 100-ns - * ticks since the Windows epoch. */ - Tcl_WideInt usecSincePosixEpoch; - /* Current microseconds since Posix epoch. */ QueryPerformanceCounter(&curCounter); @@ -606,19 +615,18 @@ NativeGetMicroseconds(void) */ EnterCriticalSection(&timeInfo.cs); - fileTimeLastCall.QuadPart = timeInfo.fileTimeLastCall.QuadPart; - perfCounterLastCall.QuadPart = timeInfo.perfCounterLastCall.QuadPart; - curCounterFreq.QuadPart = timeInfo.curCounterFreq.QuadPart; + fileTimeLastCall = timeInfo.fileTimeLastCall.QuadPart; + perfCounterLastCall = timeInfo.perfCounterLastCall.QuadPart; + curCounterFreq = timeInfo.curCounterFreq.QuadPart; LeaveCriticalSection(&timeInfo.cs); /* * If calibration cycle occurred after we get curCounter */ - if (curCounter.QuadPart <= perfCounterLastCall.QuadPart) { - usecSincePosixEpoch = - (fileTimeLastCall.QuadPart - posixEpoch.QuadPart) / 10; - return usecSincePosixEpoch; + if (curCounter.QuadPart <= perfCounterLastCall) { + /* Calibrated file-time is saved from posix in 100-ns ticks */ + return fileTimeLastCall / 10; } /* @@ -631,15 +639,12 @@ NativeGetMicroseconds(void) * loop should recover. */ - if (curCounter.QuadPart - perfCounterLastCall.QuadPart < - 11 * curCounterFreq.QuadPart / 10 + if (curCounter.QuadPart - perfCounterLastCall < + 11 * curCounterFreq * timeInfo.calibrationInterv / 10 ) { - curFileTime = fileTimeLastCall.QuadPart + - ((curCounter.QuadPart - perfCounterLastCall.QuadPart) - * 10000000 / curCounterFreq.QuadPart); - - usecSincePosixEpoch = (curFileTime - posixEpoch.QuadPart) / 10; - return usecSincePosixEpoch; + /* Calibrated file-time is saved from posix in 100-ns ticks */ + return NativeCalc100NsTicks(fileTimeLastCall, + perfCounterLastCall, curCounterFreq, curCounter.QuadPart) / 10; } } @@ -710,6 +715,8 @@ NativeGetTime( *---------------------------------------------------------------------- */ +void TclWinResetTimerResolution(void); + static void StopCalibration( ClientData unused) /* Client data is unused */ @@ -1076,6 +1083,8 @@ CalibrationThread( QueryPerformanceFrequency(&timeInfo.curCounterFreq); timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime; timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime; + /* Calibrated file-time will be saved from posix in 100-ns ticks */ + timeInfo.fileTimeLastCall.QuadPart -= timeInfo.posixEpoch.QuadPart; ResetCounterSamples(timeInfo.fileTimeLastCall.QuadPart, timeInfo.perfCounterLastCall.QuadPart, @@ -1135,6 +1144,7 @@ UpdateTimeEachSecond(void) /* Current value returned from * QueryPerformanceCounter. */ FILETIME curSysTime; /* Current system time. */ + static LARGE_INTEGER lastFileTime; /* File time of the previous calibration */ LARGE_INTEGER curFileTime; /* File time at the time this callback was * scheduled. */ Tcl_WideInt estFreq; /* Estimated perf counter frequency. */ @@ -1146,15 +1156,24 @@ UpdateTimeEachSecond(void) * step over 1 second. */ /* - * Sample performance counter and system time. + * Sample performance counter and system time (from posix epoch). */ - QueryPerformanceCounter(&curPerfCounter); GetSystemTimeAsFileTime(&curSysTime); curFileTime.LowPart = curSysTime.dwLowDateTime; curFileTime.HighPart = curSysTime.dwHighDateTime; - - EnterCriticalSection(&timeInfo.cs); + curFileTime.QuadPart -= timeInfo.posixEpoch.QuadPart; + /* If calibration still not needed (check for possible time switch) */ + if ( curFileTime.QuadPart > lastFileTime.QuadPart + && curFileTime.QuadPart < lastFileTime.QuadPart + + (timeInfo.calibrationInterv * 10000000) + ) { + /* again in next one second */ + return; + } + QueryPerformanceCounter(&curPerfCounter); + + lastFileTime.QuadPart = curFileTime.QuadPart; /* * We devide by timeInfo.curCounterFreq.QuadPart in several places. That @@ -1166,7 +1185,6 @@ UpdateTimeEachSecond(void) */ if (timeInfo.curCounterFreq.QuadPart == 0){ - LeaveCriticalSection(&timeInfo.cs); timeInfo.perfCounterAvailable = 0; return; } @@ -1185,7 +1203,7 @@ UpdateTimeEachSecond(void) * estimate the performance counter frequency. */ - estFreq = AccumulateSample(curPerfCounter.QuadPart, + estFreq = AccumulateSample(curPerfCounter.QuadPart, (Tcl_WideUInt) curFileTime.QuadPart); /* @@ -1205,12 +1223,9 @@ UpdateTimeEachSecond(void) * is estFreq * 20000000 / (vt1 - vt0) */ - vt0 = 10000000 * (curPerfCounter.QuadPart - - timeInfo.perfCounterLastCall.QuadPart) - / timeInfo.curCounterFreq.QuadPart - + timeInfo.fileTimeLastCall.QuadPart; - vt1 = 20000000 + curFileTime.QuadPart; - + vt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart, + timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart, + curPerfCounter.QuadPart); /* * If we've gotten more than a second away from system time, then drifting * the clock is going to be pretty hopeless. Just let it jump. Otherwise, @@ -1219,21 +1234,75 @@ UpdateTimeEachSecond(void) tdiff = vt0 - curFileTime.QuadPart; if (tdiff > 10000000 || tdiff < -10000000) { - timeInfo.fileTimeLastCall.QuadPart = curFileTime.QuadPart; - timeInfo.curCounterFreq.QuadPart = estFreq; + /* jump to current system time, use curent estimated frequency */ + vt0 = curFileTime.QuadPart; } else { - driftFreq = estFreq * 20000000 / (vt1 - vt0); + /* calculate new frequency and estimate drift to the next second */ + vt1 = 20000000 + curFileTime.QuadPart; + driftFreq = (estFreq * 20000000 / (vt1 - vt0)); + /* + * Avoid too large drifts (only half of the current difference), + * that allows also be more accurate (aspire to the smallest tdiff), + * so then we can prolong calibration interval by tdiff < 100000 + */ + driftFreq = timeInfo.curCounterFreq.QuadPart + + (driftFreq - timeInfo.curCounterFreq.QuadPart) / 2; - if (driftFreq > 1003*estFreq/1000) { - driftFreq = 1003*estFreq/1000; - } else if (driftFreq < 997*estFreq/1000) { - driftFreq = 997*estFreq/1000; + /* + * Average between estimated, 2 current and 5 drifted frequencies, + * (do the soft drifting as possible) + */ + estFreq = (estFreq + 2 * timeInfo.curCounterFreq.QuadPart + 5 * driftFreq) / 8; + } + + /* Avoid too large discrepancy from nominal frequency */ + if (estFreq > 1003*timeInfo.nominalFreq.QuadPart/1000) { + estFreq = 1003*timeInfo.nominalFreq.QuadPart/1000; + vt0 = curFileTime.QuadPart; + } else if (estFreq < 997*timeInfo.nominalFreq.QuadPart/1000) { + estFreq = 997*timeInfo.nominalFreq.QuadPart/1000; + vt0 = curFileTime.QuadPart; + } else if (vt0 != curFileTime.QuadPart) { + /* + * Be sure the clock ticks never backwards (avoid it by negative drifting) + * just compare native time (in 100-ns) before and hereafter using + * new calibrated values) and do a small adjustment (short time freeze) + */ + LARGE_INTEGER newPerfCounter; + Tcl_WideInt nt0, nt1; + + QueryPerformanceCounter(&newPerfCounter); + nt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart, + timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart, + newPerfCounter.QuadPart); + nt1 = NativeCalc100NsTicks(vt0, + curPerfCounter.QuadPart, estFreq, + newPerfCounter.QuadPart); + if (nt0 > nt1) { /* drifted backwards, try to compensate with new base */ + /* first adjust with a micro jump (short frozen time is acceptable) */ + vt0 += nt0 - nt1; + /* if drift unavoidable (e. g. we had a time switch), then reset it */ + vt1 = vt0 - curFileTime.QuadPart; + if (vt1 > 10000000 || vt1 < -10000000) { + /* larger jump resp. shift relative new file-time */ + vt0 = curFileTime.QuadPart; + } } + } + + /* In lock commit new values to timeInfo (hold lock as short as possible) */ + EnterCriticalSection(&timeInfo.cs); - timeInfo.fileTimeLastCall.QuadPart = vt0; - timeInfo.curCounterFreq.QuadPart = driftFreq; + /* grow calibration interval up to 10 seconds (if still precise enough) */ + if (tdiff < -100000 || tdiff > 100000) { + /* too long drift - reset calibration interval to 1000 second */ + timeInfo.calibrationInterv = 1; + } else if (timeInfo.calibrationInterv < 10) { + timeInfo.calibrationInterv++; } + timeInfo.fileTimeLastCall.QuadPart = vt0; + timeInfo.curCounterFreq.QuadPart = estFreq; timeInfo.perfCounterLastCall.QuadPart = curPerfCounter.QuadPart; LeaveCriticalSection(&timeInfo.cs); -- cgit v0.12 From 4b4a960bfbfd688eb26f0a9947a4487bd8dc7291 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 7 Feb 2019 21:20:52 +0000 Subject: timerate: added dynamic factor by threshold calculation (avoid growing of the execution time if iterations are not consistent, e. g. wax continuously on time) --- generic/tclCmdMZ.c | 31 ++++++++++++++++++++++++------- 1 file changed, 24 insertions(+), 7 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index ee47561..dd4c2a6 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4298,13 +4298,15 @@ Tcl_TimeRateObjCmd( register Tcl_Obj *objPtr; register int result, i; Tcl_Obj *calibrate = NULL, *direct = NULL; - Tcl_WideInt count = 0; /* Holds repetition count */ + Tcl_WideUInt count = 0; /* Holds repetition count */ Tcl_WideInt maxms = -0x7FFFFFFFFFFFFFFFL; /* Maximal running time (in milliseconds) */ - Tcl_WideInt threshold = 1; /* Current threshold for check time (faster + Tcl_WideUInt threshold = 1; /* Current threshold for check time (faster * repeat count without time check) */ - Tcl_WideInt maxIterTm = 1; /* Max time of some iteration as max threshold + Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max threshold * additionally avoid divide to zero (never < 1) */ + unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid + * growth of execution time. */ register Tcl_WideInt start, middle, stop; #ifndef TCL_WIDE_CLICKS Tcl_Time now; @@ -4500,8 +4502,8 @@ usage: break; } - /* don't calculate threshold by few iterations, because sometimes - * first iteration(s) can be too fast (cached, delayed clean up, etc) */ + /* don't calculate threshold by few iterations, because sometimes first + * iteration(s) can be too fast or slow (cached, delayed clean up, etc) */ if (count < 10) { threshold = 1; continue; } @@ -4510,9 +4512,24 @@ usage: threshold = (middle - start) / count; if (threshold > maxIterTm) { maxIterTm = threshold; + /* interations seems to be longer */ + if (threshold > (maxIterTm * 2)) { + if ((factor *= 2) > 50) factor = 50; + } else { + if (factor < 50) factor++; + } + } else if (factor > 4) { + /* interations seems to be shorter */ + if (threshold < (maxIterTm / 2)) { + if ((factor /= 2) < 4) factor = 4; + } else { + factor--; + } } - /* as relation between remaining time and time since last check */ - threshold = ((stop - middle) / maxIterTm) / 4; + /* as relation between remaining time and time since last check, + * maximal some % of time (by factor), so avoid growing of the execution time + * if iterations are not consistent, e. g. wax continuously on time) */ + threshold = ((stop - middle) / maxIterTm) / factor + 1; if (threshold > 100000) { /* fix for too large threshold */ threshold = 100000; } -- cgit v0.12 From 1890d482a7b98d4bf0f3e024c415a9b266e4f55e Mon Sep 17 00:00:00 2001 From: "sergey.brester" Date: Tue, 12 Feb 2019 19:35:37 +0000 Subject: cherrypick [8ad25ef9eb] from 8.6 - timerate: added dynamic factor by threshold calculation (avoid growing of the execution time if iterations are not consistent, e. g. wax continuously on time) --- generic/tclCmdMZ.c | 31 ++++++++++++++++++++++++------- 1 file changed, 24 insertions(+), 7 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 2786f0d..87504de 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3985,13 +3985,15 @@ Tcl_TimeRateObjCmd( register Tcl_Obj *objPtr; register int result, i; Tcl_Obj *calibrate = NULL, *direct = NULL; - Tcl_WideInt count = 0; /* Holds repetition count */ + Tcl_WideUInt count = 0; /* Holds repetition count */ Tcl_WideInt maxms = -0x7FFFFFFFFFFFFFFFL; /* Maximal running time (in milliseconds) */ - Tcl_WideInt threshold = 1; /* Current threshold for check time (faster + Tcl_WideUInt threshold = 1; /* Current threshold for check time (faster * repeat count without time check) */ - Tcl_WideInt maxIterTm = 1; /* Max time of some iteration as max threshold + Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max threshold * additionally avoid divide to zero (never < 1) */ + unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid + * growth of execution time. */ register Tcl_WideInt start, middle, stop; #ifndef TCL_WIDE_CLICKS Tcl_Time now; @@ -4184,8 +4186,8 @@ usage: break; } - /* don't calculate threshold by few iterations, because sometimes - * first iteration(s) can be too fast (cached, delayed clean up, etc) */ + /* don't calculate threshold by few iterations, because sometimes first + * iteration(s) can be too fast or slow (cached, delayed clean up, etc) */ if (count < 10) { threshold = 1; continue; } @@ -4194,9 +4196,24 @@ usage: threshold = (middle - start) / count; if (threshold > maxIterTm) { maxIterTm = threshold; + /* interations seems to be longer */ + if (threshold > (maxIterTm * 2)) { + if ((factor *= 2) > 50) factor = 50; + } else { + if (factor < 50) factor++; + } + } else if (factor > 4) { + /* interations seems to be shorter */ + if (threshold < (maxIterTm / 2)) { + if ((factor /= 2) < 4) factor = 4; + } else { + factor--; + } } - /* as relation between remaining time and time since last check */ - threshold = ((stop - middle) / maxIterTm) / 4; + /* as relation between remaining time and time since last check, + * maximal some % of time (by factor), so avoid growing of the execution time + * if iterations are not consistent, e. g. wax continuously on time) */ + threshold = ((stop - middle) / maxIterTm) / factor + 1; if (threshold > 100000) { /* fix for too large threshold */ threshold = 100000; } -- cgit v0.12 From 6a355b11a62eca55d96068c29b918339a100b467 Mon Sep 17 00:00:00 2001 From: "sergey.brester" Date: Tue, 12 Feb 2019 19:38:46 +0000 Subject: timerate: allow break from measurement cycle (usable to provide conditional stop possibility inside timerate) --- generic/tclCmdMZ.c | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 87504de..4ee43ea 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4169,7 +4169,14 @@ usage: result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); } if (result != TCL_OK) { - goto done; + /* allow break from measurement cycle (used for conditional stop) */ + if (result != TCL_BREAK) { + goto done; + } + /* force stop immediately */ + threshold = 1; + stop = -0x7FFFFFFFFFFFFFFFL; + result = TCL_OK; } /* don't check time up to threshold */ -- cgit v0.12 From e0587d15645be0b1c8a11d3b4ea82a23ecebf595 Mon Sep 17 00:00:00 2001 From: "sergey.brester" Date: Tue, 12 Feb 2019 19:46:29 +0000 Subject: fixes estimated time of too short execution considering calibrated overhead (it is 0us and not 1us, example: `timerate {break}` with and without calibration) --- generic/tclCmdMZ.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 4ee43ea..cb44e08 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4243,11 +4243,11 @@ usage: /* minimize influence of measurement overhead */ if (overhead > 0) { /* estimate the time of overhead (microsecs) */ - Tcl_WideInt curOverhead = overhead * count; + Tcl_WideUInt curOverhead = overhead * count; if (middle > curOverhead) { middle -= curOverhead; } else { - middle = 1; + middle = 0; } } } else { -- cgit v0.12 From f7183b361eac28e93e37b226ab5fd1b1166b882c Mon Sep 17 00:00:00 2001 From: "sergey.brester" Date: Tue, 12 Feb 2019 20:37:11 +0000 Subject: few test cases for timerate command --- tests/cmdMZ.test | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index 7fe4fda..fcb09df 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -347,6 +347,51 @@ test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { invoked from within "time {error foo}"}} +test cmdMZ-6.1 {Tcl_TimeRateObjCmd: basic format of command} { + list [catch {timerate} msg] $msg +} {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time?"}} +test cmdMZ-6.2 {Tcl_TimeRateObjCmd: basic format of command} { + list [catch {timerate a b c} msg] $msg +} {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time?"}} +test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} { + list [catch {timerate a b} msg] $msg +} {1 {expected integer but got "b"}} +test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} { + list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg +} {1 {missing close-brace}} +test cmdMZ-6.5 {Tcl_TimeRateObjCmd: result format and one iteration} { + regexp {^\d+.\d+ [.]s/# 1 # \d+ #/sec \d+.\d+ nett-ms$} [timerate {} 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 +"timerate {error foo} 1"}} +test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} { + set m1 [timerate {break}] + list \ + [expr {[lindex $m1 0] < 1000}] \ + [expr {[lindex $m1 2] == 1}] \ + [expr {[lindex $m1 4] > 1000}] \ + [expr {[lindex $m1 6] < 10}] +} {1 1 1 1} + # The tests for Tcl_WhileObjCmd are in while.test # cleanup -- cgit v0.12 From 2d41d8b6e28534be5e6713250740a76e56d417ef Mon Sep 17 00:00:00 2001 From: "sergey.brester" Date: Tue, 12 Feb 2019 20:40:12 +0000 Subject: small amend (correct wrong utf-8 prevention for micro sign in RE of check test-case) --- tests/cmdMZ.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index fcb09df..08f1ffe 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -360,7 +360,7 @@ test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg } {1 {missing close-brace}} test cmdMZ-6.5 {Tcl_TimeRateObjCmd: result format and one iteration} { - regexp {^\d+.\d+ [.]s/# 1 # \d+ #/sec \d+.\d+ nett-ms$} [timerate {} 0] + regexp {^\d+.\d+ \ws/# 1 # \d+ #/sec \d+.\d+ nett-ms$} [timerate {} 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] -- cgit v0.12 From 5add43aac85a1d21f7b0ee6b9c9f43eb0a747918 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 13 Feb 2019 01:10:16 +0000 Subject: timerate: extended with ?max-count? optional parameter, code review and more tests --- generic/tclCmdMZ.c | 39 +++++++++++++++++++++++++++------------ generic/tclPort.h | 3 +++ tests/cmdMZ.test | 27 +++++++++++++++++++++++---- 3 files changed, 53 insertions(+), 16 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index cb44e08..ba86203 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3986,8 +3986,10 @@ Tcl_TimeRateObjCmd( register int result, i; Tcl_Obj *calibrate = NULL, *direct = NULL; Tcl_WideUInt count = 0; /* Holds repetition count */ - Tcl_WideInt maxms = -0x7FFFFFFFFFFFFFFFL; + Tcl_WideInt maxms = WIDE_MIN; /* Maximal running time (in milliseconds) */ + Tcl_WideUInt maxcnt = WIDE_MAX; + /* Maximal count of iterations. */ Tcl_WideUInt threshold = 1; /* Current threshold for check time (faster * repeat count without time check) */ Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max threshold @@ -4036,24 +4038,32 @@ Tcl_TimeRateObjCmd( } } - if (i >= objc || i < objc-2) { + if (i >= objc || i < objc-3) { usage: - Tcl_WrongNumArgs(interp, 1, objv, "?-direct? ?-calibrate? ?-overhead double? command ?time?"); + Tcl_WrongNumArgs(interp, 1, objv, "?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"); return TCL_ERROR; } objPtr = objv[i++]; - if (i < objc) { - result = Tcl_GetWideIntFromObj(interp, objv[i], &maxms); + if (i < objc) { /* max-time */ + result = Tcl_GetWideIntFromObj(interp, objv[i++], &maxms); if (result != TCL_OK) { return result; } + if (i < objc) { /* max-count*/ + Tcl_WideInt v; + result = Tcl_GetWideIntFromObj(interp, objv[i], &v); + if (result != TCL_OK) { + return result; + } + maxcnt = (v > 0) ? v : 0; + } } /* if calibrate */ if (calibrate) { /* if no time specified for the calibration */ - if (maxms == -0x7FFFFFFFFFFFFFFFL) { + if (maxms == WIDE_MIN) { Tcl_Obj *clobjv[6]; Tcl_WideInt maxCalTime = 5000; double lastMeasureOverhead = measureOverhead; @@ -4083,7 +4093,7 @@ usage: clobjv[i++] = objPtr; /* set last measurement overhead to max */ - measureOverhead = (double)0x7FFFFFFFFFFFFFFFL; + measureOverhead = (double)UWIDE_MAX; /* calibration cycle until it'll be preciser */ maxms = -1000; @@ -4117,14 +4127,14 @@ usage: /* if time is negative - make current overhead more precise */ if (maxms > 0) { /* set last measurement overhead to max */ - measureOverhead = (double)0x7FFFFFFFFFFFFFFFL; + measureOverhead = (double)UWIDE_MAX; } else { maxms = -maxms; } } - if (maxms == -0x7FFFFFFFFFFFFFFFL) { + if (maxms == WIDE_MIN) { maxms = 1000; } if (overhead == -1) { @@ -4157,6 +4167,7 @@ usage: #endif /* start measurement */ + if (maxcnt > 0) while (1) { /* eval single iteration */ count++; @@ -4175,7 +4186,7 @@ usage: } /* force stop immediately */ threshold = 1; - stop = -0x7FFFFFFFFFFFFFFFL; + maxcnt = 0; result = TCL_OK; } @@ -4189,7 +4200,7 @@ usage: Tcl_GetTime(&now); middle = now.sec; middle *= 1000000; middle += now.usec; #endif - if (middle >= stop) { + if (middle >= stop || count >= maxcnt) { break; } @@ -4224,6 +4235,10 @@ usage: if (threshold > 100000) { /* fix for too large threshold */ threshold = 100000; } + /* consider max-count */ + if (threshold > maxcnt - count) { + threshold = maxcnt - count; + } } { @@ -4276,7 +4291,7 @@ usage: /* calculate speed as rate (count) per sec */ if (!middle) middle++; /* +1 ms, just to avoid divide by zero */ - if (count < (0x7FFFFFFFFFFFFFFFL / 1000000)) { + if (count < (WIDE_MAX / 1000000)) { val = (count * 1000000) / middle; if (val < 100000) { if (val < 100) { fmt = "%.3f"; } else diff --git a/generic/tclPort.h b/generic/tclPort.h index 12a60db..9485567 100644 --- a/generic/tclPort.h +++ b/generic/tclPort.h @@ -39,5 +39,8 @@ # define LLONG_MAX (~LLONG_MIN) #endif +#define UWIDE_MAX ((Tcl_WideUInt)-1) +#define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1)) +#define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1)) #endif /* _TCLPORT */ diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index 08f1ffe..60f6236 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -349,13 +349,19 @@ test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { test cmdMZ-6.1 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate} msg] $msg -} {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time?"}} -test cmdMZ-6.2 {Tcl_TimeRateObjCmd: basic format of command} { +} {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"}} +test cmdMZ-6.2.1 {Tcl_TimeRateObjCmd: basic format of command} { + list [catch {timerate a b c d} msg] $msg +} {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"}} +test cmdMZ-6.2.2 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate a b c} msg] $msg -} {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time?"}} -test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} { +} {1 {expected integer but got "b"}} +test cmdMZ-6.2.3 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate a b} msg] $msg } {1 {expected integer but got "b"}} +test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} { + list [catch {timerate -overhead b {} a b} msg] $msg +} {1 {expected floating-point number but got "b"}} test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} { list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg } {1 {missing close-brace}} @@ -391,6 +397,19 @@ test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} { [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} # The tests for Tcl_WhileObjCmd are in while.test -- cgit v0.12 From 963cceee572b9eb7fca08a7401a07a5263f5dc40 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 13 Feb 2019 01:22:07 +0000 Subject: timerate documentation extended --- doc/timerate.n | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/doc/timerate.n b/doc/timerate.n index df9a8f7..2380597 100644 --- a/doc/timerate.n +++ b/doc/timerate.n @@ -11,17 +11,20 @@ .SH NAME timerate \- Time-related execution resp. performance measurement of a script .SH SYNOPSIS -\fBtimerate \fIscript\fR \fI?time?\fR +\fBtimerate \fIscript\fR \fI?time ?max-count??\fR .sp -\fBtimerate \fI?-direct?\fR \fI?-overhead double?\fR \fIscript\fR \fI?time?\fR +\fBtimerate \fI?-direct?\fR \fI?-overhead double?\fR \fIscript\fR \fI?time ?max-count??\fR .sp -\fBtimerate \fI?-calibrate?\fR \fI?-direct?\fR \fIscript\fR \fI?time?\fR +\fBtimerate \fI?-calibrate?\fR \fI?-direct?\fR \fIscript\fR \fI?time ?max-count??\fR .BE .SH DESCRIPTION .PP The first and second form will evaluate \fIscript\fR until the interval \fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second) -if \fItime\fR is not specified. +if \fItime\fR is not specified. +.sp +If \fImax-count\fR is specified, it imposes a further restriction by the maximal +number of iterations. .sp It will then return a canonical tcl-list of the form .PP -- cgit v0.12 From a548454c575b079ba2d442b8976b4e66ac8109d1 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 4 Mar 2019 20:39:09 +0000 Subject: re-integrates the changes from the TIP#527 description into the manpage --- doc/timerate.n | 62 +++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 37 insertions(+), 25 deletions(-) diff --git a/doc/timerate.n b/doc/timerate.n index 2380597..d10e657 100644 --- a/doc/timerate.n +++ b/doc/timerate.n @@ -23,13 +23,15 @@ The first and second form will evaluate \fIscript\fR until the interval \fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second) if \fItime\fR is not specified. .sp -If \fImax-count\fR is specified, it imposes a further restriction by the maximal -number of iterations. +The parameter \fImax-count\fR could additionally impose a further restriction +by the maximal number of iterations to evaluate the script. +If \fImax-count\fR is specified, the evalution will stop either this count of +iterations is reached or the time is exceeded. .sp It will then return a canonical tcl-list of the form .PP .CS -\f0.095977 µs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR +\fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR .CE .PP which indicates: @@ -42,34 +44,42 @@ the estimated rate per second (lindex $result 4) .IP \(bu the estimated real execution time without measurement overhead (lindex $result 6) .PP -Time is measured in elapsed time using heighest timer resolution as possible, not CPU time. -This command may be used to provide information as to how well the script or a tcl-command -is performing and can help determine bottlenecks and fine-tune application performance. -.PP +Time is measured in elapsed time using the finest timer resolution as possible, +not CPU time. +This command may be used to provide information as to how well the script or a +tcl-command is performing and can help determine bottlenecks and fine-tune +application performance. +.TP \fI-calibrate\fR . To measure very fast scripts as exact as posible the calibration process may be required. -This parameter used to calibrate \fBtimerate\fR calculating the estimated overhead -of given \fIscript\fR as default overhead for further execution of \fBtimerate\fR. -It can take up to 10 seconds if parameter \fItime\fR is not specified. -.PP +The \fI-calibrate\fR option is used to calibrate timerate, calculating the +estimated overhead of the given script as the default overhead for future +invocations of the \fBtimerate\fR command. If the \fItime\fR parameter is not +specified, the calibrate procedure runs for up to 10 seconds. +.TP \fI-overhead double\fR . -This parameter used to supply the measurement overhead of single iteration -(in microseconds) that should be ignored during whole evaluation process. -.PP +The \fI-overhead\fR parameter supplies an estimate (in microseconds) of the +measurement overhead of each iteration of the tested script. This quantity +will be subtracted from the measured time prior to reporting results. +.TP \fI-direct\fR . -Causes direct execution per iteration (not compiled variant of evaluation used). +The \fI-direct\fR option causes direct execution of the supplied script, +without compilation, in a manner similar to the \fBtime\fR command. It can be +used to measure the cost of \fBTcl_EvalObjEx\fR, of the invocation of canonical +lists, and of the uncompiled versions of bytecoded commands. .PP -In opposition to \fBtime\fR the execution limited here by fixed time instead of -repetition count. -Additionally the compiled variant of the script will be used during whole evaluation -(as if it were part of a compiled \fBproc\fR), if parameter \fI-direct\fR is not specified. -Therefore it provides more precise results and prevents very long execution time -by slow scripts resp. scripts with unknown speed. +As opposed to the \fBtime\fR commmand, which runs the tested script for a fixed +number of iterations, the timerate command runs it for a fixed time. +Additionally, the compiled variant of the script will be used during the entire +measurement, as if the script were part of a compiled procedure, if the \fI-direct\fR +option is not specified. The fixed time period and possibility of compilation allow +for more precise results and prevent very long execution times by slow scripts, making +it practical for measuring scripts with highly uncertain execution times. .SH EXAMPLE Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including @@ -82,8 +92,9 @@ timerate -calibrate {} timerate { for {set i 0} {$i<10} {incr i} {} } 5000 .CE .PP -Estimate how fast it takes for a simple Tcl \fBfor\fR loop only (ignoring the -overhead for operations on variable \fIi\fR) to count to a ten: +Estimate how fast it takes for a simple Tcl \fBfor\fR loop, ignoring the +overhead for to perform ten iterations, ignoring the overhead of the management +of the variable that controls the loop: .PP .CS # calibrate for overhead of variable operations: @@ -92,8 +103,9 @@ set i 0; timerate -calibrate {expr {$i<10}; incr i} 1000 timerate { for {set i 0} {$i<10} {incr i} {} } 5000 .CE .PP -Estimate the rate of calculating the hour using \fBclock format\fR only, ignoring -overhead of the rest, without measurement how fast it takes for a whole script: +Estimate the speed of calculating the hour of the day using \fBclock format\fR only, +ignoring overhead of the portion of the script that prepares the time for it to +calculate: .PP .CS # calibrate: -- cgit v0.12 From ecc6d3264bd29eafec826d73f8295c4846d98801 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 4 Mar 2019 20:40:54 +0000 Subject: tools/tcltk-man2html: html-code for micro (sec) character --- tools/tcltk-man2html.tcl | 1 + 1 file changed, 1 insertion(+) diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index 9f95f7b..262f696 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -352,6 +352,7 @@ proc process-text {text} { {\(em} "—" \ {\(fm} "′" \ {\(mu} "×" \ + {\(mc} "µ" \ {\(->} "→" \ {\fP} {\fR} \ {\.} . \ -- cgit v0.12 From 18c4dc903ac4958a254cc697a371c45acfba53a8 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 4 Mar 2019 20:50:39 +0000 Subject: amend: html-code order changed --- tools/tcltk-man2html.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index 262f696..04891eb 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -351,8 +351,8 @@ proc process-text {text} { {\(co} "©" \ {\(em} "—" \ {\(fm} "′" \ - {\(mu} "×" \ {\(mc} "µ" \ + {\(mu} "×" \ {\(->} "→" \ {\fP} {\fR} \ {\.} . \ -- cgit v0.12 From e50b8ab06822b043814960f2addc955d3559b089 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 5 Mar 2019 10:07:53 +0000 Subject: highlighting --- doc/timerate.n | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/timerate.n b/doc/timerate.n index d10e657..3c764c8 100644 --- a/doc/timerate.n +++ b/doc/timerate.n @@ -36,13 +36,13 @@ It will then return a canonical tcl-list of the form .PP which indicates: .IP \(bu -the average amount of time required per iteration, in microseconds (lindex $result 0) +the average amount of time required per iteration, in microseconds ([\fBlindex\fR $result 0]) .IP \(bu -the count how many times it was executed (lindex $result 2) +the count how many times it was executed ([\fBlindex\fR $result 2]) .IP \(bu -the estimated rate per second (lindex $result 4) +the estimated rate per second ([\fBlindex\fR $result 4]) .IP \(bu -the estimated real execution time without measurement overhead (lindex $result 6) +the estimated real execution time without measurement overhead ([\fBlindex\fR $result 6]) .PP Time is measured in elapsed time using the finest timer resolution as possible, not CPU time. -- cgit v0.12 From 00f20c7d65dde544bc8d32494bffddd0b2f17300 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 5 Mar 2019 11:22:30 +0000 Subject: regarding the TIP#527, `timerate` shall be placed into `::tcl::unsupported` in versions prior to 8.7 --- generic/tclBasic.c | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 5c2d7e4..b148333 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -203,7 +203,9 @@ static const CmdInfo builtInCmds[] = { {"source", Tcl_SourceObjCmd, NULL, 0}, {"tell", Tcl_TellObjCmd, NULL, 1}, {"time", Tcl_TimeObjCmd, NULL, 1}, +#ifdef TCL_TIMERATE {"timerate", Tcl_TimeRateObjCmd, NULL, 1}, +#endif {"unload", Tcl_UnloadObjCmd, NULL, 0}, {"update", Tcl_UpdateObjCmd, NULL, 1}, {"vwait", Tcl_VwaitObjCmd, NULL, 1}, @@ -387,7 +389,7 @@ Tcl_CreateInterp(void) const BuiltinFuncDef *builtinFuncPtr; const OpCmdInfo *opcmdInfoPtr; const CmdInfo *cmdInfoPtr; - Tcl_Namespace *mathfuncNSPtr, *mathopNSPtr; + Tcl_Namespace *nsPtr; union { char c[sizeof(short)]; short s; @@ -722,6 +724,17 @@ Tcl_CreateInterp(void) Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble", Tcl_DisassembleObjCmd, NULL, NULL); + /* Create an unsupported command for timerate */ + Tcl_CreateObjCommand(interp, "::tcl::unsupported::timerate", + Tcl_TimeRateObjCmd, NULL, NULL); + + /* Export unsupported commands */ + nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0); + if (nsPtr) { + Tcl_Export(interp, nsPtr, "*", 1); + } + + #ifdef USE_DTRACE /* * Register the tcl::dtrace command. @@ -734,8 +747,8 @@ Tcl_CreateInterp(void) * Register the builtin math functions. */ - mathfuncNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL); - if (mathfuncNSPtr == NULL) { + nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL); + if (nsPtr == NULL) { Tcl_Panic("Can't create math function namespace"); } strcpy(mathFuncName, "::tcl::mathfunc::"); @@ -745,19 +758,19 @@ Tcl_CreateInterp(void) strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); Tcl_CreateObjCommand(interp, mathFuncName, builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL); - Tcl_Export(interp, mathfuncNSPtr, builtinFuncPtr->name, 0); + Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0); } /* * Register the mathematical "operator" commands. [TIP #174] */ - mathopNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL); + nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL); #define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */ - if (mathopNSPtr == NULL) { + if (nsPtr == NULL) { Tcl_Panic("can't create math operator namespace"); } - (void) Tcl_Export(interp, mathopNSPtr, "*", 1); + (void) Tcl_Export(interp, nsPtr, "*", 1); strcpy(mathFuncName, "::tcl::mathop::"); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){ TclOpCmdClientData *occdPtr = (TclOpCmdClientData *) -- cgit v0.12 From b424e061934eba8c7799ee5fdbc92aa7fb1bed5a Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 5 Mar 2019 11:28:54 +0000 Subject: helper to import `timerate` on demand in unknown/autoload proceeding. --- library/tclIndex | 3 +++ 1 file changed, 3 insertions(+) diff --git a/library/tclIndex b/library/tclIndex index 010616f..c1ccb16 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -85,3 +85,6 @@ set auto_index(::tcl::tm::list) [list source [file join $dir tm.tcl]] set auto_index(::tcl::tm::UnknownHandler) [list source [file join $dir tm.tcl]] set auto_index(::tcl::tm::roots) [list source [file join $dir tm.tcl]] set auto_index(::tcl::tm::path) [list source [file join $dir tm.tcl]] +if {[namespace exists ::tcl::unsupported]} { + set auto_index(timerate) {namespace import ::tcl::unsupported::timerate} +} -- cgit v0.12 From 6d9266494b57aade906d8ed8a62c7648dcb26bb7 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 5 Mar 2019 12:56:22 +0000 Subject: back-porting test-performance suite and clock.perf.tcl from clock-speedup branch --- tests-perf/clock.perf.tcl | 411 ++++++++++++++++++++++++++++++++++++++++ tests-perf/test-performance.tcl | 121 ++++++++++++ 2 files changed, 532 insertions(+) create mode 100644 tests-perf/clock.perf.tcl create mode 100644 tests-perf/test-performance.tcl diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl new file mode 100644 index 0000000..d574c2c --- /dev/null +++ b/tests-perf/clock.perf.tcl @@ -0,0 +1,411 @@ +#!/usr/bin/tclsh +# ------------------------------------------------------------------------ +# +# test-performance.tcl -- +# +# This file provides common performance tests for comparison of tcl-speed +# degradation by switching between branches. +# (currently for clock ensemble only) +# +# ------------------------------------------------------------------------ +# +# Copyright (c) 2014 Serg G. Brester (aka sebres) +# +# See the file "license.terms" for information on usage and redistribution +# of this file. +# + +array set in {-time 500} +if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { + array set in $argv +} + +## common test performance framework: +if {![namespace exists ::tclTestPerf]} { + source [file join [file dirname [info script]] test-performance.tcl] +} + +namespace eval ::tclTestPerf-TclClock { + +namespace path {::tclTestPerf} + +## set testing defaults: +set ::env(TCL_TZ) :CET + +# warm-up interpeter compiler env, clock platform-related features: + +## warm-up test-related features (load clock.tcl, system zones, locales, etc.): +clock scan "" -gmt 1 +clock scan "" +clock scan "" -timezone :CET +clock scan "" -format "" -locale en +clock scan "" -format "" -locale de + +## ------------------------------------------ + +proc test-format {{reptime 1000}} { + _test_run $reptime { + # Format : short, week only (in gmt) + {clock format 1482525936 -format "%u" -gmt 1} + # Format : short, week only (system zone) + {clock format 1482525936 -format "%u"} + # Format : short, week only (CEST) + {clock format 1482525936 -format "%u" -timezone :CET} + # Format : date only (in gmt) + {clock format 1482525936 -format "%Y-%m-%d" -gmt 1} + # Format : date only (system zone) + {clock format 1482525936 -format "%Y-%m-%d"} + # Format : date only (CEST) + {clock format 1482525936 -format "%Y-%m-%d" -timezone :CET} + # Format : time only (in gmt) + {clock format 1482525936 -format "%H:%M" -gmt 1} + # Format : time only (system zone) + {clock format 1482525936 -format "%H:%M"} + # Format : time only (CEST) + {clock format 1482525936 -format "%H:%M" -timezone :CET} + # Format : time only (in gmt) + {clock format 1482525936 -format "%H:%M:%S" -gmt 1} + # Format : time only (system zone) + {clock format 1482525936 -format "%H:%M:%S"} + # Format : time only (CEST) + {clock format 1482525936 -format "%H:%M:%S" -timezone :CET} + # Format : default (in gmt) + {clock format 1482525936 -gmt 1 -locale en} + # Format : default (system zone) + {clock format 1482525936 -locale en} + # Format : default (CEST) + {clock format 1482525936 -timezone :CET -locale en} + # Format : ISO date-time (in gmt, numeric zone) + {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1} + # Format : ISO date-time (system zone, CEST, numeric zone) + {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z"} + # Format : ISO date-time (CEST, numeric zone) + {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -timezone :CET} + # Format : ISO date-time (system zone, CEST) + {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %Z"} + # Format : julian day with time (in gmt): + {clock format 1246379415 -format "%J %H:%M:%S" -gmt 1} + # Format : julian day with time (system zone): + {clock format 1246379415 -format "%J %H:%M:%S"} + + # Format : locale date-time (en): + {clock format 1246379415 -format "%x %X" -locale en} + # Format : locale date-time (de): + {clock format 1246379415 -format "%x %X" -locale de} + + # Format : locale lookup table month: + {clock format 1246379400 -format "%b" -locale en -gmt 1} + # Format : locale lookup 2 tables - month and day: + {clock format 1246379400 -format "%b %Od" -locale en -gmt 1} + # Format : locale lookup 3 tables - week, month and day: + {clock format 1246379400 -format "%a %b %Od" -locale en -gmt 1} + # Format : locale lookup 4 tables - week, month, day and year: + {clock format 1246379400 -format "%a %b %Od %Oy" -locale en -gmt 1} + + # Format : dynamic clock value (without converter caches): + setup {set i 0} + {clock format [incr i] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET} + cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]} + # Format : dynamic clock value (without any converter caches, zone range overflow): + setup {set i 0} + {clock format [incr i 86400] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET} + cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]} + + # Format : dynamic format (cacheable) + {clock format 1246379415 -format [string trim "%d.%m.%Y %H:%M:%S "] -gmt 1} + + # Format : all (in gmt, locale en) + {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -gmt 1 -locale en} + # Format : all (in CET, locale de) + {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -timezone :CET -locale de} + } +} + +proc test-scan {{reptime 1000}} { + _test_run $reptime { + # Scan : date (in gmt) + {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1} + # Scan : date (system time zone, with base) + {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0} + # Scan : date (system time zone, without base) + {clock scan "25.11.2015" -format "%d.%m.%Y"} + # Scan : greedy match + {clock scan "111" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "1111" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "11111" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "111111" -format "%d%m%y" -base 0 -gmt 1} + # Scan : greedy match (space separated) + {clock scan "1 1 1" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "111 1" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "1 111" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "1 11 1" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "1 11 11" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "11 11 11" -format "%d%m%y" -base 0 -gmt 1} + + # Scan : time (in gmt) + {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000 -gmt 1} + # Scan : time (system time zone, with base) + {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000} + # Scan : time (gmt, without base) + {clock scan "10:35:55" -format "%H:%M:%S" -gmt 1} + # Scan : time (system time zone, without base) + {clock scan "10:35:55" -format "%H:%M:%S"} + + # Scan : date-time (in gmt) + {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0 -gmt 1} + # Scan : date-time (system time zone with base) + {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0} + # Scan : date-time (system time zone without base) + {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S"} + + # Scan : julian day in gmt + {clock scan 2451545 -format %J -gmt 1} + # Scan : julian day in system TZ + {clock scan 2451545 -format %J} + # Scan : julian day in other TZ + {clock scan 2451545 -format %J -timezone +0200} + # Scan : julian day with time: + {clock scan "2451545 10:20:30" -format "%J %H:%M:%S"} + # Scan : julian day with time (greedy match): + {clock scan "2451545 102030" -format "%J%H%M%S"} + + # Scan : century, lookup table month + {clock scan {1970 Jan 2} -format {%C%y %b %d} -locale en -gmt 1} + # Scan : century, lookup table month and day (both entries are first) + {clock scan {1970 Jan 01} -format {%C%y %b %Od} -locale en -gmt 1} + # Scan : century, lookup table month and day (list scan: entries with position 12 / 31) + {clock scan {2016 Dec 31} -format {%C%y %b %Od} -locale en -gmt 1} + + # Scan : ISO date-time (CEST) + {clock scan "2009-06-30T18:30:00+02:00" -format "%Y-%m-%dT%H:%M:%S%z"} + {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"} + # Scan : ISO date-time (UTC) + {clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S%z"} + {clock scan "2009-06-30T18:30:00 UTC" -format "%Y-%m-%dT%H:%M:%S %z"} + + # Scan : locale date-time (en): + {clock scan "06/30/2009 18:30:15" -format "%x %X" -gmt 1 -locale en} + # Scan : locale date-time (de): + {clock scan "30.06.2009 18:30:15" -format "%x %X" -gmt 1 -locale de} + + # Scan : dynamic format (cacheable) + {clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1} + + break + # # Scan : long format test (allock chain) + # {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1} + # # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc): + # {clock scan "25.11.2015" -format [string repeat "[incr i] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} + # # Scan : again: + # {clock scan "25.11.2015" -format [string repeat "[incr i -1] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} + } {puts [clock format $_(r) -locale en]} +} + +proc test-freescan {{reptime 1000}} { + _test_run $reptime { + # FreeScan : relative date + {clock scan "5 years 18 months 385 days" -base 0 -gmt 1} + # FreeScan : relative date with relative weekday + {clock scan "5 years 18 months 385 days Fri" -base 0 -gmt 1} + # FreeScan : relative date with ordinal month + {clock scan "5 years 18 months 385 days next 1 January" -base 0 -gmt 1} + # FreeScan : relative date with ordinal month and relative weekday + {clock scan "5 years 18 months 385 days next January Fri" -base 0 -gmt 1} + # FreeScan : ordinal month + {clock scan "next January" -base 0 -gmt 1} + # FreeScan : relative week + {clock scan "next Fri" -base 0 -gmt 1} + # FreeScan : relative weekday and week offset + {clock scan "next January + 2 week" -base 0 -gmt 1} + # FreeScan : time only with base + {clock scan "19:18:30" -base 148863600 -gmt 1} + # FreeScan : time only without base, gmt + {clock scan "19:18:30" -gmt 1} + # FreeScan : time only without base, system + {clock scan "19:18:30"} + # FreeScan : date, system time zone + {clock scan "05/08/2016 20:18:30"} + # FreeScan : date, supplied time zone + {clock scan "05/08/2016 20:18:30" -timezone :CET} + # FreeScan : date, supplied gmt (equivalent -timezone :GMT) + {clock scan "05/08/2016 20:18:30" -gmt 1} + # FreeScan : date, supplied time zone gmt + {clock scan "05/08/2016 20:18:30" -timezone :GMT} + # FreeScan : time only, numeric zone in string, base time gmt (exchange zones between gmt / -0500) + {clock scan "20:18:30 -0500" -base 148863600 -gmt 1} + # FreeScan : time only, zone in string (exchange zones between system / gmt) + {clock scan "19:18:30 GMT" -base 148863600} + # FreeScan : fast switch of zones in cycle - GMT, MST, CET (system) and EST + {clock scan "19:18:30 MST" -base 148863600 -gmt 1 + clock scan "19:18:30 EST" -base 148863600 + } + } {puts [clock format $_(r) -locale en]} +} + +proc test-add {{reptime 1000}} { + set tests { + # Add : years + {clock add 1246379415 5 years -gmt 1} + # Add : months + {clock add 1246379415 18 months -gmt 1} + # Add : weeks + {clock add 1246379415 20 weeks -gmt 1} + # Add : days + {clock add 1246379415 385 days -gmt 1} + # Add : weekdays + {clock add 1246379415 3 weekdays -gmt 1} + + # Add : hours + {clock add 1246379415 5 hours -gmt 1} + # Add : minutes + {clock add 1246379415 55 minutes -gmt 1} + # Add : seconds + {clock add 1246379415 100 seconds -gmt 1} + + # Add : +/- in gmt + {clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -gmt 1} + # Add : +/- in system timezone + {clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -timezone :CET} + + # Add : gmt + {clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -gmt 1} + # Add : system timezone + {clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -timezone :CET} + + # Add : all in gmt + {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -gmt 1} + # Add : all in system timezone + {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -timezone :CET} + + } + # if does not support add of weekdays: + if {[catch {clock add 0 3 weekdays -gmt 1}]} { + regsub -all {\mweekdays\M} $tests "days" tests + } + _test_run $reptime $tests {puts [clock format $_(r) -locale en]} +} + +proc test-convert {{reptime 1000}} { + _test_run $reptime { + # Convert locale (en -> de): + {clock format [clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en] -format "%a %b %d %Y" -gmt 1 -locale de} + # Convert locale (de -> en): + {clock format [clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de] -format "%a %b %d %Y" -gmt 1 -locale en} + + # Convert TZ: direct + {clock format [clock scan "19:18:30" -base 148863600 -timezone EST] -timezone MST} + {clock format [clock scan "19:18:30" -base 148863600 -timezone MST] -timezone EST} + # Convert TZ: included in scan string & format + {clock format [clock scan "19:18:30 EST" -base 148863600] -format "%H:%M:%S %z" -timezone MST} + {clock format [clock scan "19:18:30 EST" -base 148863600] -format "%H:%M:%S %z" -timezone EST} + + # Format locale 1x: comparison values + {clock format 0 -gmt 1 -locale en} + {clock format 0 -gmt 1 -locale de} + {clock format 0 -gmt 1 -locale fr} + # Format locale 2x: without switching locale (en, en) + {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en} + # Format locale 2x: with switching locale (en, de) + {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale de} + # Format locale 3x: without switching locale (en, en, en) + {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en} + # Format locale 3x: with switching locale (en, de, fr) + {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale de; clock format 0 -gmt 1 -locale fr} + + # Scan locale 2x: without switching locale (en, en) + (de, de) + {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en} + {clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de} + # Scan locale 2x: with switching locale (en, de) + {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de} + # Scan locale 3x: with switching locale (en, de, fr) + {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de; clock scan "mar. mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale fr} + + # Format TZ 2x: comparison values + {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"} + {clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"} + # Format TZ 2x: without switching + {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"} + {clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"} + # Format TZ 2x: with switching + {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"} + # Format TZ 3x: with switching (CET, EST, MST) + {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone MST -format "%Y-%m-%d %H:%M:%S %z"} + # Format TZ 3x: with switching (GMT, EST, MST) + {clock format 0 -gmt 1 -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone MST -format "%Y-%m-%d %H:%M:%S %z"} + + # FreeScan TZ 2x (+1 system-default): without switching TZ + {clock scan "19:18:30 MST" -base 148863600; clock scan "19:18:30 MST" -base 148863600} + {clock scan "19:18:30 EST" -base 148863600; clock scan "19:18:30 EST" -base 148863600} + # FreeScan TZ 2x (+1 system-default): with switching TZ + {clock scan "19:18:30 MST" -base 148863600; clock scan "19:18:30 EST" -base 148863600} + # FreeScan TZ 2x (+1 gmt, +1 system-default) + {clock scan "19:18:30 MST" -base 148863600 -gmt 1; clock scan "19:18:30 EST" -base 148863600} + + # Scan TZ: comparison included in scan string vs. given + {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"} + {clock scan "2009-06-30T18:30:00 CET" -format "%Y-%m-%dT%H:%M:%S %z"} + {clock scan "2009-06-30T18:30:00" -timezone CET -format "%Y-%m-%dT%H:%M:%S"} + } +} + +proc test-other {{reptime 1000}} { + _test_run $reptime { + # Bad zone + {catch {clock scan "1 day" -timezone BAD_ZONE -locale en}} + + # Scan : julian day (overflow) + {catch {clock scan 5373485 -format %J}} + + # Scan : test rotate of GC objects (format is dynamic, so tcl-obj removed with last reference) + {set i 0; time { clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} + # Scan : test reusability of GC objects (format is dynamic, so tcl-obj removed with last reference) + {set i 50; time { clock scan "[incr i -1] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} + } +} + +proc test-ensemble-perf {{reptime 1000}} { + _test_run $reptime { + # Clock clicks (ensemble) + {clock clicks} + # Clock clicks (direct) + {::tcl::clock::clicks} + # Clock seconds (ensemble) + {clock seconds} + # Clock seconds (direct) + {::tcl::clock::seconds} + # Clock microseconds (ensemble) + {clock microseconds} + # Clock microseconds (direct) + {::tcl::clock::microseconds} + # Clock scan (ensemble) + {clock scan ""} + # Clock scan (direct) + {::tcl::clock::scan ""} + # Clock format (ensemble) + {clock format 0 -f %s} + # Clock format (direct) + {::tcl::clock::format 0 -f %s} + } +} + +proc test {{reptime 1000}} { + puts "" + test-ensemble-perf [expr {$reptime / 2}]; #fast enough + test-format $reptime + test-scan $reptime + test-freescan $reptime + test-add $reptime + test-convert [expr {$reptime / 2}]; #fast enough + test-other $reptime + + puts \n**OK** +} + +}; # end of ::tclTestPerf-TclClock + +# ------------------------------------------------------------------------ + +# if calling direct: +if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { + ::tclTestPerf-TclClock::test $in(-time) +} diff --git a/tests-perf/test-performance.tcl b/tests-perf/test-performance.tcl new file mode 100644 index 0000000..b0cbb17 --- /dev/null +++ b/tests-perf/test-performance.tcl @@ -0,0 +1,121 @@ +# ------------------------------------------------------------------------ +# +# test-performance.tcl -- +# +# This file provides common performance tests for comparison of tcl-speed +# degradation or regression by switching between branches. +# +# To execute test case evaluate direct corresponding file "tests-perf\*.perf.tcl". +# +# ------------------------------------------------------------------------ +# +# Copyright (c) 2014 Serg G. Brester (aka sebres) +# +# See the file "license.terms" for information on usage and redistribution +# of this file. +# + +namespace eval ::tclTestPerf { +# warm-up interpeter compiler env, calibrate timerate measurement functionality: + +# if no timerate here - import from unsupported: +if {[namespace which -command timerate] eq {}} { + namespace inscope ::tcl::unsupported {namespace export timerate} + namespace import ::tcl::unsupported::timerate +} + +# if not yet calibrated: +if {[lindex [timerate {} 10] 6] >= (10-1)} { + puts -nonewline "Calibration ... "; flush stdout + puts "done: [lrange \ + [timerate -calibrate {}] \ + 0 1]" +} + +proc {**STOP**} {args} { + return -code error -level 4 "**STOP** in [info level [expr {[info level]-2}]] [join $args { }]" +} + +proc _test_get_commands {lst} { + regsub -all {(?:^|\n)[ \t]*(\#[^\n]*|\msetup\M[^\n]*|\mcleanup\M[^\n]*)(?=\n\s*(?:[\{\#]|setup|cleanup|$))} $lst "\n{\\1}" +} + +proc _test_out_total {} { + upvar _ _ + + set tcnt [llength $_(itm)] + if {!$tcnt} { + puts "" + return + } + + set mintm 0x7fffffff + set maxtm 0 + set nett 0 + set wtm 0 + set wcnt 0 + set i 0 + foreach tm $_(itm) { + if {[llength $tm] > 6} { + set nett [expr {$nett + [lindex $tm 6]}] + } + set wtm [expr {$wtm + [lindex $tm 0]}] + set wcnt [expr {$wcnt + [lindex $tm 2]}] + set tm [lindex $tm 0] + if {$tm > $maxtm} {set maxtm $tm; set maxi $i} + if {$tm < $mintm} {set mintm $tm; set mini $i} + incr i + } + + puts [string repeat ** 40] + set s [format "%d cases in %.2f sec." $tcnt [expr {([clock milliseconds] - $_(starttime)) / 1000.0}]] + if {$nett > 0} { + append s [format " (%.2f nett-sec.)" [expr {$nett / 1000.0}]] + } + puts "Total $s:" + lset _(m) 0 [format %.6f $wtm] + lset _(m) 2 $wcnt + lset _(m) 4 [format %.3f [expr {$wcnt / (($nett ? $nett : ($tcnt * $_(reptime))) / 1000.0)}]] + if {[llength $_(m)] > 6} { + lset _(m) 6 [format %.3f $nett] + } + puts $_(m) + puts "Average:" + lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / $tcnt}]] + lset _(m) 2 [expr {[lindex $_(m) 2] / $tcnt}] + if {[llength $_(m)] > 6} { + lset _(m) 6 [format %.3f [expr {[lindex $_(m) 6] / $tcnt}]] + lset _(m) 4 [format %.0f [expr {[lindex $_(m) 2] / [lindex $_(m) 6] * 1000}]] + } + puts $_(m) + puts "Min:" + puts [lindex $_(itm) $mini] + puts "Max:" + puts [lindex $_(itm) $maxi] + puts [string repeat ** 40] + puts "" +} + +proc _test_run {reptime lst {outcmd {puts $_(r)}}} { + upvar _ _ + array set _ [list itm {} reptime $reptime starttime [clock milliseconds]] + + foreach _(c) [_test_get_commands $lst] { + puts "% [regsub -all {\n[ \t]*} $_(c) {; }]" + if {[regexp {^\s*\#} $_(c)]} continue + if {[regexp {^\s*(?:setup|cleanup)\s+} $_(c)]} { + puts [if 1 [lindex $_(c) 1]] + continue + } + if {$reptime > 1} {; #if not once: + set _(r) [if 1 $_(c)] + if {$outcmd ne {}} $outcmd + } + puts [set _(m) [timerate $_(c) $reptime]] + lappend _(itm) $_(m) + puts "" + } + _test_out_total +} + +}; # end of namespace ::tclTestPerf -- cgit v0.12 From 1568393cf3615816e44c90bc533a69e60c6b7ede Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 5 Mar 2019 12:58:11 +0000 Subject: back-porting other performance test (timer-event.perf.tcl) from event-perf-branch --- tests-perf/timer-event.perf.tcl | 219 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 219 insertions(+) create mode 100644 tests-perf/timer-event.perf.tcl diff --git a/tests-perf/timer-event.perf.tcl b/tests-perf/timer-event.perf.tcl new file mode 100644 index 0000000..6732a81 --- /dev/null +++ b/tests-perf/timer-event.perf.tcl @@ -0,0 +1,219 @@ +#!/usr/bin/tclsh + +# ------------------------------------------------------------------------ +# +# timer-event.perf.tcl -- +# +# This file provides performance tests for comparison of tcl-speed +# of timer events (event-driven tcl-handling). +# +# ------------------------------------------------------------------------ +# +# Copyright (c) 2014 Serg G. Brester (aka sebres) +# +# See the file "license.terms" for information on usage and redistribution +# of this file. +# + + +if {![namespace exists ::tclTestPerf]} { + source [file join [file dirname [info script]] test-performance.tcl] +} + + +namespace eval ::tclTestPerf-Timer-Event { + +namespace path {::tclTestPerf} + +proc test-queue {howmuch} { + + # because of extremely short measurement times by tests below, wait a little bit (warming-up), + # to minimize influence of the time-gradation (just for better dispersion resp. result-comparison) + timerate {after 0} 156 + + puts "*** $howmuch events ***" + _test_run 0 [string map [list \$howmuch $howmuch \\# \#] { + + # generate $howmuch idle-events: + {time {after idle {set foo bar}} $howmuch; llength [after info]} + # update / after idle: + {update; \# $howmuch idle-events} + + # generate $howmuch idle-events: + {time {after idle {set foo bar}} $howmuch; llength [after info]} + # update idletasks / after idle: + {update idletasks; \# $howmuch idle-events} + + # generate $howmuch immediate events: + {time {after 0 {set foo bar}} $howmuch; llength [after info]} + # update / after 0: + {update; \# $howmuch timer-events} + + # generate $howmuch 1-ms events: + {time {after 1 {set foo bar}} $howmuch; llength [after info]} + setup {after 1} + # update / after 1: + {update; \# $howmuch timer-events} + + # generate $howmuch immediate events (+ 1 event of the second generation): + {time {after 0 {after 0 {}}} $howmuch; llength [after info]} + # update / after 0 (double generation): + {while {1} {update; if {![llength [after info]]} break }; \# all generations of events} + + # cancel forwards "after idle" / $howmuch idle-events in queue: + setup {set i 0; time {set ev([incr i]) [after idle {set foo bar}]} $howmuch} + {set i 0; time {after cancel $ev([incr i])} $howmuch} + cleanup {update; unset -nocomplain ev} + # cancel backwards "after idle" / $howmuch idle-events in queue: + setup {set i 0; time {set ev([incr i]) [after idle {set foo bar}]} $howmuch} + {incr i; time {after cancel $ev([incr i -1])} $howmuch} + cleanup {update; unset -nocomplain ev} + + # cancel forwards "after 0" / $howmuch timer-events in queue: + setup {set i 0; time {set ev([incr i]) [after 0 {set foo bar}]} $howmuch} + {set i 0; time {after cancel $ev([incr i])} $howmuch} + cleanup {update; unset -nocomplain ev} + # cancel backwards "after 0" / $howmuch timer-events in queue: + setup {set i 0; time {set ev([incr i]) [after 0 {set foo bar}]} $howmuch} + {incr i; time {after cancel $ev([incr i -1])} $howmuch} + cleanup {update; unset -nocomplain ev} + # end $howmuch events. + }] +} + +proc test-access {{reptime 1000}} { + foreach count {5000 50000} { + _test_run $reptime [string map [list \$count $count] { + # event random access: after idle + after info (by $count events) + setup {set i -1; time {set ev([incr i]) [after idle {}]} $count; array size ev } + {after info $ev([expr {int(rand()*$count)}])} + cleanup {update; unset -nocomplain ev} + # event random access: after 0 + after info (by $count events) + setup {set i -1; time {set ev([incr i]) [after 0 {}]} $count; array size ev} + {after info $ev([expr {int(rand()*$count)}])} + cleanup {update; unset -nocomplain ev} + }] + } +} + +proc test-exec {{reptime 1000}} { + _test_run $reptime { + # after idle + after cancel + {after cancel [after idle {set foo bar}]} + # after 0 + after cancel + {after cancel [after 0 {set foo bar}]} + # after idle + update idletasks + {after idle {set foo bar}; update idletasks} + # after idle + update + {after idle {set foo bar}; update} + # immediate: after 0 + update + {after 0 {set foo bar}; update} + # delayed: after 1 + update + {after 1 {set foo bar}; update} + # empty update: + {update} + # empty update idle tasks: + {update idletasks} + + # simple shortest sleep: + {after 0} + } +} + +proc test-exec-new {{reptime 1000}} { + _test_run $reptime { + # conditional update pure idle only (without window): + {update -idle} + # conditional update without idle events: + {update -noidle} + # conditional update timers only: + {update -timer} + # conditional update AIO only: + {update -async} + + # conditional vwait with zero timeout: pure idle only (without window): + {vwait -idle 0 x} + # conditional vwait with zero timeout: without idle events: + {vwait -noidle 0 x} + # conditional vwait with zero timeout: timers only: + {vwait -timer 0 x} + # conditional vwait with zero timeout: AIO only: + {vwait -async 0 x} + } +} + +proc test-nrt-capability {{reptime 1000}} { + _test_run $reptime { + # comparison values: + {after 0 {set a 5}; update} + {after 0 {set a 5}; vwait a} + + # conditional vwait with very brief wait-time: + {vwait 1 a} + {vwait 0.5 a} + {vwait 0.2 a} + {vwait 0.1 a} + {vwait 0.05 a} + {vwait 0.02 a} + {vwait 0.01 a} + {vwait 0.005 a} + {vwait 0.001 a} + + # NRT sleep / very brief delays (0.5 - 0.005): + {after 0.5} + {after 0.05} + {after 0.005} + # NRT sleep / very brief delays (0.1 - 0.001): + {after 0.1} + {after 0.01} + {after 0.001} + + # comparison of update's executing event: + {after idle {set a 5}; update -idle -timer} + {after 0 {set a 5}; update -idle -timer} + {after idle {set a 5}; update -idle} + # comparison of vwait's executing event: + {after idle {set a 5}; vwait -idle -timer a} + {after 0 {set a 5}; vwait -idle -timer a} + {after idle {set a 5}; vwait -idle a} + } +} + +proc test-long {{reptime 1000}} { + _test_run $reptime { + # in-between important event by amount of idle events: + {time {after idle {after 30}} 10; after 1 {set important 1}; vwait important;} + cleanup {foreach i [after info] {after cancel $i}} + # in-between important event (of new generation) by amount of idle events: + {time {after idle {after 30}} 10; after 1 {after 0 {set important 1}}; vwait important;} + cleanup {foreach i [after info] {after cancel $i}} + } +} + +proc test {{reptime 1000}} { + test-exec $reptime + test-access $reptime + if {![catch {update -noidle}]} { + test-exec-new $reptime + test-nrt-capability $reptime + } + test-long $reptime + + puts "" + foreach howmuch { 10000 20000 40000 60000 } { + test-queue $howmuch + } + + puts \n**OK** +} + +}; # end of ::tclTestPerf-Timer-Event + +# ------------------------------------------------------------------------ + +# if calling direct: +if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { + array set in {-time 500} + array set in $argv + ::tclTestPerf-Timer-Event::test $in(-time) +} -- cgit v0.12 From 2e2fdf481a1adc01e01df1b72add387325868bfd Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 5 Mar 2019 15:46:31 +0000 Subject: extended performance test-suite, since max-count is implemented in timerate, usage `::tclTestPerf::_test_run ?-no-result? reptime lst ?outcmd?`; update timer-event.perf.tcl for better readability (covering execution in multiple iterations now regarding max-count, so provides more precise result now); removed unused test-cases here (new cases of event-perf-branch only). --- tests-perf/test-performance.tcl | 31 +++++++-- tests-perf/timer-event.perf.tcl | 145 +++++++++++++++------------------------- 2 files changed, 81 insertions(+), 95 deletions(-) diff --git a/tests-perf/test-performance.tcl b/tests-perf/test-performance.tcl index b0cbb17..4629cd4 100644 --- a/tests-perf/test-performance.tcl +++ b/tests-perf/test-performance.tcl @@ -75,7 +75,7 @@ proc _test_out_total {} { puts "Total $s:" lset _(m) 0 [format %.6f $wtm] lset _(m) 2 $wcnt - lset _(m) 4 [format %.3f [expr {$wcnt / (($nett ? $nett : ($tcnt * $_(reptime))) / 1000.0)}]] + lset _(m) 4 [format %.3f [expr {$wcnt / (($nett ? $nett : ($tcnt * [lindex $_(reptime) 0])) / 1000.0)}]] if {[llength $_(m)] > 6} { lset _(m) 6 [format %.3f $nett] } @@ -96,10 +96,29 @@ proc _test_out_total {} { puts "" } -proc _test_run {reptime lst {outcmd {puts $_(r)}}} { +proc _test_run {args} { upvar _ _ + # parse args: + set _(out-result) 1 + if {[lindex $args 0] eq "-no-result"} { + set _(out-result) 0 + set args [lrange $args 1 end] + } + if {[llength $args] < 2 || [llength $args] > 3} { + return -code error "wrong # args: should be \"[lindex [info level [info level]] 0] ?-no-result? reptime lst ?outcmd?\"" + } + set outcmd {puts $_(r)} + set args [lassign $args reptime lst] + if {[llength $args]} { + set outcmd [lindex $args 0] + } + # avoid output if only once: + if {[lindex $reptime 0] <= 1 || ([llength $reptime] > 1 && [lindex $reptime 1] == 1)} { + set _(out-result) 0 + } array set _ [list itm {} reptime $reptime starttime [clock milliseconds]] + # process measurement: foreach _(c) [_test_get_commands $lst] { puts "% [regsub -all {\n[ \t]*} $_(c) {; }]" if {[regexp {^\s*\#} $_(c)]} continue @@ -107,11 +126,15 @@ proc _test_run {reptime lst {outcmd {puts $_(r)}}} { puts [if 1 [lindex $_(c) 1]] continue } - if {$reptime > 1} {; #if not once: + # if output result (and not once): + if {$_(out-result)} { set _(r) [if 1 $_(c)] if {$outcmd ne {}} $outcmd + if {[llength $_(reptime)] > 1} { # decrement max-count + lset _(reptime) 1 [expr {[lindex $_(reptime) 1] - 1}] + } } - puts [set _(m) [timerate $_(c) $reptime]] + puts [set _(m) [timerate $_(c) {*}$_(reptime)]] lappend _(itm) $_(m) puts "" } diff --git a/tests-perf/timer-event.perf.tcl b/tests-perf/timer-event.perf.tcl index 6732a81..805f0f8 100644 --- a/tests-perf/timer-event.perf.tcl +++ b/tests-perf/timer-event.perf.tcl @@ -25,75 +25,86 @@ namespace eval ::tclTestPerf-Timer-Event { namespace path {::tclTestPerf} -proc test-queue {howmuch} { +proc test-queue {{reptime {1000 10000}}} { + + set howmuch [lindex $reptime 1] # because of extremely short measurement times by tests below, wait a little bit (warming-up), # to minimize influence of the time-gradation (just for better dispersion resp. result-comparison) timerate {after 0} 156 - puts "*** $howmuch events ***" - _test_run 0 [string map [list \$howmuch $howmuch \\# \#] { - - # generate $howmuch idle-events: - {time {after idle {set foo bar}} $howmuch; llength [after info]} + puts "*** up to $howmuch events ***" + # single iteration by update, so using -no-result (measure only): + _test_run -no-result $reptime [string map [list \{*\}\$reptime $reptime \$howmuch $howmuch \\# \#] { + # generate up to $howmuch idle-events: + {after idle {set foo bar}} # update / after idle: - {update; \# $howmuch idle-events} + {update; if {![llength [after info]]} break} - # generate $howmuch idle-events: - {time {after idle {set foo bar}} $howmuch; llength [after info]} + # generate up to $howmuch idle-events: + {after idle {set foo bar}} # update idletasks / after idle: - {update idletasks; \# $howmuch idle-events} + {update idletasks; if {![llength [after info]]} break} - # generate $howmuch immediate events: - {time {after 0 {set foo bar}} $howmuch; llength [after info]} + # generate up to $howmuch immediate events: + {after 0 {set foo bar}} # update / after 0: - {update; \# $howmuch timer-events} + {update; if {![llength [after info]]} break} - # generate $howmuch 1-ms events: - {time {after 1 {set foo bar}} $howmuch; llength [after info]} + # generate up to $howmuch 1-ms events: + {after 1 {set foo bar}} setup {after 1} # update / after 1: - {update; \# $howmuch timer-events} + {update; if {![llength [after info]]} break} - # generate $howmuch immediate events (+ 1 event of the second generation): - {time {after 0 {after 0 {}}} $howmuch; llength [after info]} + # generate up to $howmuch immediate events (+ 1 event of the second generation): + {after 0 {after 0 {}}} # update / after 0 (double generation): - {while {1} {update; if {![llength [after info]]} break }; \# all generations of events} + {update; if {![llength [after info]]} break} # cancel forwards "after idle" / $howmuch idle-events in queue: - setup {set i 0; time {set ev([incr i]) [after idle {set foo bar}]} $howmuch} - {set i 0; time {after cancel $ev([incr i])} $howmuch} + setup {set i 0; timerate {set ev([incr i]) [after idle {set foo bar}]} {*}$reptime} + setup {set le $i; set i 0; list 1 .. $le; # cancel up to $howmuch events} + {after cancel $ev([incr i]); if {$i >= $le} break} cleanup {update; unset -nocomplain ev} # cancel backwards "after idle" / $howmuch idle-events in queue: - setup {set i 0; time {set ev([incr i]) [after idle {set foo bar}]} $howmuch} - {incr i; time {after cancel $ev([incr i -1])} $howmuch} + setup {set i 0; timerate {set ev([incr i]) [after idle {set foo bar}]} {*}$reptime} + setup {set le $i; incr i; list $le .. 1; # cancel up to $howmuch events} + {after cancel $ev([incr i -1]); if {$i <= 1} break} cleanup {update; unset -nocomplain ev} # cancel forwards "after 0" / $howmuch timer-events in queue: - setup {set i 0; time {set ev([incr i]) [after 0 {set foo bar}]} $howmuch} - {set i 0; time {after cancel $ev([incr i])} $howmuch} + setup {set i 0; timerate {set ev([incr i]) [after 0 {set foo bar}]} {*}$reptime} + setup {set le $i; set i 0; list 1 .. $le; # cancel up to $howmuch events} + {after cancel $ev([incr i]); if {$i >= $howmuch} break} cleanup {update; unset -nocomplain ev} # cancel backwards "after 0" / $howmuch timer-events in queue: - setup {set i 0; time {set ev([incr i]) [after 0 {set foo bar}]} $howmuch} - {incr i; time {after cancel $ev([incr i -1])} $howmuch} + setup {set i 0; timerate {set ev([incr i]) [after 0 {set foo bar}]} {*}$reptime} + setup {set le $i; incr i; list $le .. 1; # cancel up to $howmuch events} + {after cancel $ev([incr i -1]); if {$i <= 1} break} cleanup {update; unset -nocomplain ev} + # end $howmuch events. + cleanup {if [llength [after info]] {error "unexpected: [llength [after info]] events are still there."}} }] } -proc test-access {{reptime 1000}} { - foreach count {5000 50000} { - _test_run $reptime [string map [list \$count $count] { - # event random access: after idle + after info (by $count events) - setup {set i -1; time {set ev([incr i]) [after idle {}]} $count; array size ev } - {after info $ev([expr {int(rand()*$count)}])} +proc test-access {{reptime {1000 5000}}} { + set howmuch [lindex $reptime 1] + + _test_run $reptime [string map [list \{*\}\$reptime $reptime \$howmuch $howmuch] { + # event random access: after idle + after info (by $howmuch events) + setup {set i -1; timerate {set ev([incr i]) [after idle {}]} {*}$reptime} + {after info $ev([expr {int(rand()*$i)}])} cleanup {update; unset -nocomplain ev} - # event random access: after 0 + after info (by $count events) - setup {set i -1; time {set ev([incr i]) [after 0 {}]} $count; array size ev} - {after info $ev([expr {int(rand()*$count)}])} + # event random access: after 0 + after info (by $howmuch events) + setup {set i -1; timerate {set ev([incr i]) [after 0 {}]} {*}$reptime} + {after info $ev([expr {int(rand()*$i)}])} cleanup {update; unset -nocomplain ev} + + # end $howmuch events. + cleanup {if [llength [after info]] {error "unexpected: [llength [after info]] events are still there."}} }] - } } proc test-exec {{reptime 1000}} { @@ -120,28 +131,6 @@ proc test-exec {{reptime 1000}} { } } -proc test-exec-new {{reptime 1000}} { - _test_run $reptime { - # conditional update pure idle only (without window): - {update -idle} - # conditional update without idle events: - {update -noidle} - # conditional update timers only: - {update -timer} - # conditional update AIO only: - {update -async} - - # conditional vwait with zero timeout: pure idle only (without window): - {vwait -idle 0 x} - # conditional vwait with zero timeout: without idle events: - {vwait -noidle 0 x} - # conditional vwait with zero timeout: timers only: - {vwait -timer 0 x} - # conditional vwait with zero timeout: AIO only: - {vwait -async 0 x} - } -} - proc test-nrt-capability {{reptime 1000}} { _test_run $reptime { # comparison values: @@ -149,33 +138,8 @@ proc test-nrt-capability {{reptime 1000}} { {after 0 {set a 5}; vwait a} # conditional vwait with very brief wait-time: - {vwait 1 a} - {vwait 0.5 a} - {vwait 0.2 a} - {vwait 0.1 a} - {vwait 0.05 a} - {vwait 0.02 a} - {vwait 0.01 a} - {vwait 0.005 a} - {vwait 0.001 a} - - # NRT sleep / very brief delays (0.5 - 0.005): - {after 0.5} - {after 0.05} - {after 0.005} - # NRT sleep / very brief delays (0.1 - 0.001): - {after 0.1} - {after 0.01} - {after 0.001} - - # comparison of update's executing event: - {after idle {set a 5}; update -idle -timer} - {after 0 {set a 5}; update -idle -timer} - {after idle {set a 5}; update -idle} - # comparison of vwait's executing event: - {after idle {set a 5}; vwait -idle -timer a} - {after 0 {set a 5}; vwait -idle -timer a} - {after idle {set a 5}; vwait -idle a} + {after 1 {set a timeout}; vwait a; expr {$::a ne "timeout" ? 1 : "0[unset ::a]"}} + {after 0 {set a timeout}; vwait a; expr {$::a ne "timeout" ? 1 : "0[unset ::a]"}} } } @@ -192,16 +156,15 @@ proc test-long {{reptime 1000}} { proc test {{reptime 1000}} { test-exec $reptime - test-access $reptime - if {![catch {update -noidle}]} { - test-exec-new $reptime - test-nrt-capability $reptime + foreach howmuch {5000 50000} { + test-access [list $reptime $howmuch] } + test-nrt-capability $reptime test-long $reptime puts "" foreach howmuch { 10000 20000 40000 60000 } { - test-queue $howmuch + test-queue [list $reptime $howmuch] } puts \n**OK** -- cgit v0.12