Index: generic/tclClock.c ================================================================== --- generic/tclClock.c +++ generic/tclClock.c @@ -236,10 +236,11 @@ data->systemTimeZone = NULL; data->systemSetupTZData = NULL; data->gmtSetupTimeZoneUnnorm = NULL; data->gmtSetupTimeZone = NULL; data->gmtSetupTZData = NULL; + data->gmtTZName = NULL; data->lastSetupTimeZoneUnnorm = NULL; data->lastSetupTimeZone = NULL; data->lastSetupTZData = NULL; data->prevSetupTimeZoneUnnorm = NULL; data->prevSetupTimeZone = NULL; @@ -308,10 +309,11 @@ Tcl_UnsetObjRef(data->systemTimeZone); Tcl_UnsetObjRef(data->systemSetupTZData); Tcl_UnsetObjRef(data->gmtSetupTimeZoneUnnorm); Tcl_UnsetObjRef(data->gmtSetupTimeZone); Tcl_UnsetObjRef(data->gmtSetupTZData); + Tcl_UnsetObjRef(data->gmtTZName); Tcl_UnsetObjRef(data->lastSetupTimeZoneUnnorm); Tcl_UnsetObjRef(data->lastSetupTimeZone); Tcl_UnsetObjRef(data->lastSetupTZData); Tcl_UnsetObjRef(data->prevSetupTimeZoneUnnorm); Tcl_UnsetObjRef(data->prevSetupTimeZone); @@ -1229,21 +1231,24 @@ ClockClientData *dataPtr = clientData; int loaded; Tcl_Obj *callargs[2]; /* if cached (if already setup this one) */ - if ( dataPtr->lastSetupTimeZone != NULL - && ( timezoneObj == dataPtr->lastSetupTimeZone + if ( timezoneObj == dataPtr->literals[LIT_GMT] + && dataPtr->gmtSetupTZData != NULL + ) { + return timezoneObj; + } + if ( ( timezoneObj == dataPtr->lastSetupTimeZone || timezoneObj == dataPtr->lastSetupTimeZoneUnnorm - ) + ) && dataPtr->lastSetupTimeZone != NULL ) { return dataPtr->lastSetupTimeZone; } - if ( dataPtr->prevSetupTimeZone != NULL - && ( timezoneObj == dataPtr->prevSetupTimeZone + if ( ( timezoneObj == dataPtr->prevSetupTimeZone || timezoneObj == dataPtr->prevSetupTimeZoneUnnorm - ) + ) && dataPtr->prevSetupTimeZone != NULL ) { return dataPtr->prevSetupTimeZone; } /* differentiate normalized (last, GMT and system) zones, because used often and already set */ @@ -1552,10 +1557,19 @@ GetGregorianEraYearDay(fields, changeover); GetMonthDay(fields); GetYearWeekDay(fields, changeover); + + /* + * Seconds of the day. + */ + fields->secondOfDay = (int)(fields->localSeconds % SECONDS_PER_DAY); + if (fields->secondOfDay < 0) { + fields->secondOfDay += SECONDS_PER_DAY; + } + return TCL_OK; } /* *---------------------------------------------------------------------- @@ -2107,20 +2121,23 @@ Tcl_Obj *tzdata; /* Time zone data */ int rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */ - if (timezoneObj == dataPtr->literals[LIT_GMT] - && dataPtr->gmtSetupTZData != NULL - ) { + if (timezoneObj == dataPtr->literals[LIT_GMT]) { fields->localSeconds = fields->seconds; fields->tzOffset = 0; - if ( TclListObjGetElements(interp, dataPtr->gmtSetupTZData, &rowc, &rowv) != TCL_OK - || Tcl_ListObjIndex(interp, rowv[0], 3, &fields->tzName) != TCL_OK) { - return TCL_ERROR; + if (dataPtr->gmtTZName == NULL) { + Tcl_Obj *tzName; + tzdata = ClockGetTZData(clientData, interp, timezoneObj); + if ( TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK + || Tcl_ListObjIndex(interp, rowv[0], 3, &tzName) != TCL_OK) { + return TCL_ERROR; + } + Tcl_SetObjRef(dataPtr->gmtTZName, tzName); } - Tcl_IncrRefCount(fields->tzName); + Tcl_SetObjRef(fields->tzName, dataPtr->gmtTZName); return TCL_OK; } /* * Check cacheable conversion could be used @@ -2608,15 +2625,31 @@ GetMonthDay( TclDateFields *fields) /* Date to convert */ { int day = fields->dayOfYear; int month; - const int *h = hath[IsGregorianLeapYear(fields)]; + const int *dipm = daysInPriorMonths[IsGregorianLeapYear(fields)]; - for (month = 0; month < 12 && day > h[month]; ++month) { - day -= h[month]; + /* + * Estimate month by calculating `dayOfYear / (365/12)` + */ + month = (day*12) / dipm[12]; + /* then do forwards backwards correction */ + while (1) { + if (day > dipm[month]) { + if (month >= 11 || day <= dipm[month+1]) { + break; + } + month++; + } else { + if (month == 0) { + break; + } + month--; + } } + day -= dipm[month]; fields->month = month+1; fields->dayOfMonth = day; } /* @@ -3258,13 +3291,12 @@ return TCL_ERROR; } if (gmtFlag) { opts->timezoneObj = dataPtr->literals[LIT_GMT]; } - + else /* If time zone not specified use system time zone */ - if ( opts->timezoneObj == NULL || TclGetString(opts->timezoneObj) == NULL || opts->timezoneObj->length == 0 ) { opts->timezoneObj = ClockGetSystemTimeZone(opts->clientData, interp); @@ -4232,11 +4264,10 @@ * clockMutex. */ static long tzLastRefresh = 0; /* Used for latency before next refresh */ static size_t tzWasEpoch = 0; /* Epoch, signals that TZ changed */ static size_t tzEnvEpoch = 0; /* Last env epoch, for faster signaling, that TZ changed via TCL */ - const char *tzIsNow; /* Current value of TZ */ /* * Prevent performance regression on some platforms by resolving of system time zone: * small latency for check whether environment was changed (once per second) @@ -4245,10 +4276,11 @@ Tcl_Time now; Tcl_GetTime(&now); if (now.sec == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) { return tzWasEpoch; } + tzEnvEpoch = TclEnvEpoch; tzLastRefresh = now.sec; /* check in lock */ Tcl_MutexLock(&clockMutex); Index: generic/tclClockFmt.c ================================================================== --- generic/tclClockFmt.c +++ generic/tclClockFmt.c @@ -2414,23 +2414,36 @@ done: return ret; } + +#define FrmResultIsAllocated(dateFmt) \ + (dateFmt->resEnd - dateFmt->resMem > MIN_FMT_RESULT_BLOCK_ALLOC) static inline int FrmResultAllocate( register DateFormat *dateFmt, int len) { int needed = dateFmt->output + len - dateFmt->resEnd; if (needed >= 0) { /* >= 0 - regards NTS zero */ int newsize = dateFmt->resEnd - dateFmt->resMem - + needed + MIN_FMT_RESULT_BLOCK_ALLOC; - char *newRes = ckrealloc(dateFmt->resMem, newsize); - if (newRes == NULL) { - return TCL_ERROR; + + needed + MIN_FMT_RESULT_BLOCK_ALLOC*2; + char *newRes; + /* differentiate between stack and memory */ + if (!FrmResultIsAllocated(dateFmt)) { + newRes = ckalloc(newsize); + if (newRes == NULL) { + return TCL_ERROR; + } + memcpy(newRes, dateFmt->resMem, dateFmt->output - dateFmt->resMem); + } else { + newRes = ckrealloc(dateFmt->resMem, newsize); + if (newRes == NULL) { + return TCL_ERROR; + } } dateFmt->output = newRes + (dateFmt->output - dateFmt->resMem); dateFmt->resMem = newRes; dateFmt->resEnd = newRes + newsize; } @@ -2959,10 +2972,11 @@ ClockFmtScnCmdArgs *opts) /* Command options */ { ClockFmtScnStorage *fss; ClockFormatToken *tok; ClockFormatTokenMap *map; + char resMem[MIN_FMT_RESULT_BLOCK_ALLOC]; /* get localized format */ if (ClockLocalizeFormat(opts) == NULL) { return TCL_ERROR; } @@ -2971,23 +2985,21 @@ || !(tok = fss->fmtTok) ) { return TCL_ERROR; } - /* prepare formatting */ - dateFmt->date.secondOfDay = (int)(dateFmt->date.localSeconds % SECONDS_PER_DAY); - if (dateFmt->date.secondOfDay < 0) { - dateFmt->date.secondOfDay += SECONDS_PER_DAY; - } - /* result container object */ - dateFmt->resMem = ckalloc(MIN_FMT_RESULT_BLOCK_ALLOC); - if (dateFmt->resMem == NULL) { - return TCL_ERROR; + dateFmt->resMem = resMem; + dateFmt->resEnd = dateFmt->resMem + sizeof(resMem); + if (fss->fmtMinAlloc > sizeof(resMem)) { + dateFmt->resMem = ckalloc(fss->fmtMinAlloc); + dateFmt->resEnd = dateFmt->resMem + fss->fmtMinAlloc; + if (dateFmt->resMem == NULL) { + return TCL_ERROR; + } } dateFmt->output = dateFmt->resMem; - dateFmt->resEnd = dateFmt->resMem + MIN_FMT_RESULT_BLOCK_ALLOC; *dateFmt->output = '\0'; /* do format each token */ for (; tok->map != NULL; tok++) { map = tok->map; @@ -3080,22 +3092,39 @@ goto done; error: - ckfree(dateFmt->resMem); + if (dateFmt->resMem != resMem) { + ckfree(dateFmt->resMem); + } dateFmt->resMem = NULL; done: if (dateFmt->resMem) { + size_t size; Tcl_Obj * result = Tcl_NewObj(); result->length = dateFmt->output - dateFmt->resMem; - result->bytes = NULL; - result->bytes = ckrealloc(dateFmt->resMem, result->length+1); - if (result->bytes == NULL) { - result->bytes = dateFmt->resMem; + size = result->length+1; + if (dateFmt->resMem == resMem) { + result->bytes = ckalloc(size); + if (result->bytes == NULL) { + return TCL_ERROR; + } + memcpy(result->bytes, dateFmt->resMem, size); + } else { + result->bytes = ckrealloc(dateFmt->resMem, size); + if (result->bytes == NULL) { + result->bytes = dateFmt->resMem; + } + } + /* save last used buffer length */ + if ( dateFmt->resMem != resMem + && fss->fmtMinAlloc < size + MIN_FMT_RESULT_BLOCK_DELTA + ) { + fss->fmtMinAlloc = size + MIN_FMT_RESULT_BLOCK_DELTA; } result->bytes[result->length] = '\0'; Tcl_SetObjResult(opts->interp, result); return TCL_OK; } Index: generic/tclDate.h ================================================================== --- generic/tclDate.h +++ generic/tclDate.h @@ -291,10 +291,11 @@ Tcl_Obj *systemTimeZone; Tcl_Obj *systemSetupTZData; Tcl_Obj *gmtSetupTimeZoneUnnorm; Tcl_Obj *gmtSetupTimeZone; Tcl_Obj *gmtSetupTZData; + Tcl_Obj *gmtTZName; Tcl_Obj *lastSetupTimeZoneUnnorm; Tcl_Obj *lastSetupTimeZone; Tcl_Obj *lastSetupTZData; Tcl_Obj *prevSetupTimeZoneUnnorm; Tcl_Obj *prevSetupTimeZone; @@ -381,24 +382,25 @@ unsigned short int offs; ClockScanTokenProc *parser; const void *data; } ClockScanTokenMap; -typedef struct ClockScanToken { +struct ClockScanToken { ClockScanTokenMap *map; struct { const char *start; const char *end; } tokWord; unsigned short int endDistance; unsigned short int lookAhMin; unsigned short int lookAhMax; unsigned short int lookAhTok; -} ClockScanToken; +}; -#define MIN_FMT_RESULT_BLOCK_ALLOC 200 +#define MIN_FMT_RESULT_BLOCK_ALLOC 80 +#define MIN_FMT_RESULT_BLOCK_DELTA 30 typedef struct DateFormat { char *resMem; char *resEnd; char *output; @@ -430,22 +432,23 @@ unsigned short int divmod; unsigned short int offs; ClockFormatTokenProc *fmtproc; void *data; } ClockFormatTokenMap; -typedef struct ClockFormatToken { + +struct ClockFormatToken { ClockFormatTokenMap *map; struct { const char *start; const char *end; } tokWord; -} ClockFormatToken; +}; typedef struct ClockFmtScnStorage ClockFmtScnStorage; -typedef struct ClockFmtScnStorage { +struct ClockFmtScnStorage { int objRefCount; /* Reference count shared across threads */ ClockScanToken *scnTok; unsigned int scnTokC; unsigned int scnSpaceCount; /* Count of mandatory spaces used in format */ ClockFormatToken *fmtTok; @@ -452,15 +455,16 @@ unsigned int fmtTokC; #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 ClockFmtScnStorage *nextPtr; ClockFmtScnStorage *prevPtr; #endif + size_t fmtMinAlloc; #if 0 +Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of Tcl_HashEntry, * stored by offset +sizeof(self) */ #endif -} ClockFmtScnStorage; +}; /* * Prototypes of module functions. */ Index: generic/tclStrIdxTree.c ================================================================== --- generic/tclStrIdxTree.c +++ generic/tclStrIdxTree.c @@ -84,11 +84,11 @@ const char *start, /* UTF string to find in tree */ const char *end) /* End of string */ { TclStrIdxTree *parent = tree, *prevParent = tree; TclStrIdx *item = tree->firstPtr, *prevItem = NULL; - const char *s = start, *f, *cin, *cinf, *prevf; + const char *s = start, *f, *cin, *cinf, *prevf = NULL; int offs = 0; if (item == NULL) { goto done; } @@ -273,11 +273,12 @@ continue; } /* if shortest key was found with the same value, * just replace its current key with longest key */ if ( foundItem->value == val - && foundItem->length < lwrv[i]->length + && foundItem->length <= lwrv[i]->length + && foundItem->length <= (f - s) /* only if found item is covered in full */ && foundItem->childTree.firstPtr == NULL ) { Tcl_SetObjRef(foundItem->key, lwrv[i]); foundItem->length = lwrv[i]->length; continue; Index: tests-perf/clock.perf.tcl ================================================================== --- tests-perf/clock.perf.tcl +++ tests-perf/clock.perf.tcl @@ -14,29 +14,23 @@ # See the file "license.terms" for information on usage and redistribution # of this file. # +## 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, -# 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]" -} +# 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 @@ -43,94 +37,10 @@ clock scan "" -format "" -locale en clock scan "" -format "" -locale de ## ------------------------------------------ -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 {$tcnt * $_(reptime) / 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] - - 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 - } - set _(r) [if 1 $_(c)] - if {$outcmd ne {}} $outcmd - puts [set _(m) [timerate $_(c) $reptime]] - lappend _(itm) $_(m) - puts "" - } - _test_out_total -} - 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) @@ -480,6 +390,15 @@ test-other $reptime puts \n**OK** } -test 500; # ms +}; # end of ::tclTestPerf-TclClock + +# ------------------------------------------------------------------------ + +# 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-TclClock::test $in(-time) +} ADDED tests-perf/test-performance.tcl Index: tests-perf/test-performance.tcl ================================================================== --- /dev/null +++ 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 Index: tests/clock.test ================================================================== --- tests/clock.test +++ tests/clock.test @@ -29,10 +29,12 @@ testConstraint detroit \ [expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}] testConstraint y2038 \ [expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}] +testConstraint no_tclclockmod \ + [expr {[namespace which -command ::tcl::clock::configure] eq {}}] # TEST PLAN # clock-0: # several base test-cases @@ -253,11 +255,11 @@ return [dict get $reg $path $key] } # Base test cases: -test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" { +test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" no_tclclockmod { set i [interp create]; # because clock can be used somewhere, test it in new interp: set ret [$i eval { lappend ret ens:[namespace ensemble exists ::clock] @@ -35185,10 +35187,33 @@ test clock-29.1800 {time parsing} { clock scan {2440588 xi:lix:lix pm} \ -gmt true -locale en_US_roman \ -format {%J %Ol:%OM:%OS %P} } 86399 + +test clock-29.1811 {parsing of several localized formats} { + set res {} + foreach loc {en de fr} { + foreach fmt {"%x %X" "%X %x"} { + lappend res [clock scan \ + [clock format 0 -format $fmt -locale $loc -gmt 1] \ + -format $fmt -locale $loc -gmt 1] + } + } + set res +} [lrepeat 6 0] +test clock-29.1812 {parsing of several localized formats} { + set res {} + foreach loc {en de fr} { + foreach fmt {"%a %d-%m-%Y" "%a %b %x-%X" "%a, %x %X" "%b, %x %X"} { + lappend res [clock scan \ + [clock format 0 -format $fmt -locale $loc -gmt 1] \ + -format $fmt -locale $loc -gmt 1] + } + } + set res +} [lrepeat 12 0] # END testcases29 # BEGIN testcases30