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