diff options
| -rw-r--r-- | library/clock.tcl | 15 | ||||
| -rw-r--r-- | tests/clock.test | 278 |
2 files changed, 79 insertions, 214 deletions
diff --git a/library/clock.tcl b/library/clock.tcl index d3ad63a..dd5a9c9 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -668,14 +668,17 @@ proc ::tcl::clock::EnterLocale { locale } { #---------------------------------------------------------------------- # +# _registryExists -- # _hasRegistry -- # -# Helper that checks whether registry module is available (Windows only) +# Helpers that checks whether registry module is available (Windows only) # and loads it on demand. # +# Side effects: +# _hasRegistry does it only once, and hereafter simply returns 1 or 0. +# #---------------------------------------------------------------------- -proc ::tcl::clock::_hasRegistry {} { - set res 0 +proc ::tcl::clock::_registryExists {} { if { $::tcl_platform(platform) eq {windows} } { if { [catch { package require registry 1.3 }] } { # try to load registry directly from root (if uninstalled / development env): @@ -687,9 +690,13 @@ proc ::tcl::clock::_hasRegistry {} { }} } if { [namespace which -command ::registry] ne "" } { - set res 1 + return 1 } } + return 0 +} +proc ::tcl::clock::_hasRegistry {} { + set res [_registryExists] proc ::tcl::clock::_hasRegistry {} [list return $res] return $res } diff --git a/tests/clock.test b/tests/clock.test index e1bbc88..210239e 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -269,7 +269,6 @@ namespace eval ::testClock { DaylightStart \x00\x00\x03\x00\x02\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00]] } - proc ::testClock::registry { cmd path key } { variable reg if { $cmd ne {get} } { @@ -280,6 +279,50 @@ proc ::testClock::registry { cmd path key } { } return [dict get $reg $path $key] } +proc ::testClock::_setupRegistry {} { + rename ::tcl::clock::_hasRegistry ::tcl::clock::_org_hasRegistry + proc ::tcl::clock::_hasRegistry {} {return 1} + namespace eval ::tcl::clock { + namespace import -force ::testClock::registry + } + ::tcl::clock::ClearCaches +} +proc ::testClock::_cleanupRegistry {} { + if {[namespace which -command ::tcl::clock::registry] ne ""} { + rename ::tcl::clock::registry {} + } + rename ::tcl::clock::_hasRegistry {} + rename ::tcl::clock::_org_hasRegistry ::tcl::clock::_hasRegistry + ::tcl::clock::ClearCaches +} + +proc ::testClock::_setupNoTZ {} { + if { [info exists ::env(TZ)] } { + variable orgTZ $::env(TZ) + unset ::env(TZ) + } + if { [info exists ::env(TCL_TZ)] } { + variable orgTclTZ $::env(TCL_TZ) + unset ::env(TCL_TZ) + } +} +proc ::testClock::_cleanupNoTZ {} { + variable orgTclTZ + if { [info exists orgTclTZ] } { + set ::env(TCL_TZ) $orgTclTZ + } else { + unset -nocomplain ::env(TCL_TZ) + } + variable orgTZ + if { [info exists orgTZ] } { + set ::env(TZ) $orgTZ + } else { + unset -nocomplain ::env(TZ) + } +} + +# Don't confuse all following tests with TZ or TCL_TZ environment vars (unset them here): +::testClock::_setupNoTZ # Base test cases: @@ -35952,22 +35995,13 @@ test clock-30.34 {regression test - clock add jump over DST hole with TZ (1 day test clock-31.1 {system locale} \ -constraints {win noappverifier} \ -setup { - namespace eval ::tcl::clock { - namespace import -force ::testClock::registry - } - set noreg [info exists ::tcl::clock::NoRegistry] - if {$noreg} {unset ::tcl::clock::NoRegistry} - ::tcl::clock::ClearCaches + ::testClock::_setupRegistry } \ -body { clock format 0 -timezone :UTC -locale system -format %x } \ -cleanup { - namespace eval ::tcl::clock { - rename registry {} - } - if {$noreg} {set ::tcl::clock::NoRegistry {}} - ::tcl::clock::ClearCaches + ::testClock::_cleanupRegistry } \ -result [clock format 0 -timezone :UTC -locale current \ -format {%d-%b-%Y}] @@ -35975,22 +36009,13 @@ test clock-31.1 {system locale} \ test clock-31.2 {system locale} \ -constraints {win noappverifier} \ -setup { - namespace eval ::tcl::clock { - namespace import -force ::testClock::registry - } - set noreg [info exists ::tcl::clock::NoRegistry] - if {$noreg} {unset ::tcl::clock::NoRegistry} - ::tcl::clock::ClearCaches + ::testClock::_setupRegistry } \ -body { clock format 0 -timezone :UTC -locale system -format %Ex } \ -cleanup { - namespace eval ::tcl::clock { - rename registry {} - } - if {$noreg} {set ::tcl::clock::NoRegistry {}} - ::tcl::clock::ClearCaches + ::testClock::_cleanupRegistry } \ -result [clock format 0 -timezone :UTC -locale current \ -format {the %d' day of %B %Y}] @@ -35998,22 +36023,13 @@ test clock-31.2 {system locale} \ test clock-31.3 {system locale} \ -constraints {win noappverifier} \ -setup { - namespace eval ::tcl::clock { - namespace import -force ::testClock::registry - } - set noreg [info exists ::tcl::clock::NoRegistry] - if {$noreg} {unset ::tcl::clock::NoRegistry} - ::tcl::clock::ClearCaches + ::testClock::_setupRegistry } \ -body { clock format 0 -timezone :UTC -locale system -format %X } \ -cleanup { - namespace eval ::tcl::clock { - rename registry {} - } - if {$noreg} {set ::tcl::clock::NoRegistry {}} - ::tcl::clock::ClearCaches + ::testClock::_cleanupRegistry } \ -result [clock format 0 -timezone :UTC -locale current \ -format {%l:%M:%S %p}] @@ -36021,36 +36037,13 @@ test clock-31.3 {system locale} \ test clock-31.4 {system locale} \ -constraints {win noappverifier} \ -setup { - namespace eval ::tcl::clock { - namespace import -force ::testClock::registry - } - set noreg [info exists ::tcl::clock::NoRegistry] - if {$noreg} {unset ::tcl::clock::NoRegistry} - if { [info exists env(TZ)] } { - set oldTZ $env(TZ) - unset env(TZ) - } - if { [info exists env(TCL_TZ)] } { - set oldTclTZ $env(TCL_TZ) - unset env(TCL_TZ) - } - ::tcl::clock::ClearCaches + ::testClock::_setupRegistry } \ -body { clock format 0 -locale system -format %x } \ -cleanup { - namespace eval ::tcl::clock { - rename registry {} - } - if { [info exists oldTclTZ] } { - set env(TCL_TZ) $oldTclTZ - } - if { [info exists oldTZ] } { - set env(TZ) $oldTZ - } - if {$noreg} {set ::tcl::clock::NoRegistry {}} - ::tcl::clock::ClearCaches + ::testClock::_cleanupRegistry } \ -result [clock format 0 -locale current -timezone EST5 \ -format {%d-%b-%Y}] @@ -36058,36 +36051,13 @@ test clock-31.4 {system locale} \ test clock-31.5 {system locale} \ -constraints {win noappverifier} \ -setup { - namespace eval ::tcl::clock { - namespace import -force ::testClock::registry - } - set noreg [info exists ::tcl::clock::NoRegistry] - if {$noreg} {unset ::tcl::clock::NoRegistry} - if { [info exists env(TZ)] } { - set oldTZ $env(TZ) - unset env(TZ) - } - if { [info exists env(TCL_TZ)] } { - set oldTclTZ $env(TCL_TZ) - unset env(TCL_TZ) - } - ::tcl::clock::ClearCaches + ::testClock::_setupRegistry } \ -body { clock format 0 -locale system -format %Ex } \ -cleanup { - namespace eval ::tcl::clock { - rename registry {} - } - if {$noreg} {set ::tcl::clock::NoRegistry {}} - if { [info exists oldTclTZ] } { - set env(TCL_TZ) $oldTclTZ - } - if { [info exists oldTZ] } { - set env(TZ) $oldTZ - } - ::tcl::clock::ClearCaches + ::testClock::_cleanupRegistry } \ -result [clock format 0 -locale current -timezone EST5 \ -format {the %d' day of %B %Y}] @@ -36095,36 +36065,13 @@ test clock-31.5 {system locale} \ test clock-31.6 {system locale} \ -constraints {win noappverifier} \ -setup { - namespace eval ::tcl::clock { - namespace import -force ::testClock::registry - } - set noreg [info exists ::tcl::clock::NoRegistry] - if {$noreg} {unset ::tcl::clock::NoRegistry} - if { [info exists env(TZ)] } { - set oldTZ $env(TZ) - unset env(TZ) - } - if { [info exists env(TCL_TZ)] } { - set oldTclTZ $env(TCL_TZ) - unset env(TCL_TZ) - } - ::tcl::clock::ClearCaches + ::testClock::_setupRegistry } \ -body { clock format 0 -locale system -format "%X %Z" } \ -cleanup { - namespace eval ::tcl::clock { - rename registry {} - } - if {$noreg} {set ::tcl::clock::NoRegistry {}} - if { [info exists oldTclTZ] } { - set env(TCL_TZ) $oldTclTZ - } - if { [info exists oldTZ] } { - set env(TZ) $oldTZ - } - ::tcl::clock::ClearCaches + ::testClock::_cleanupRegistry } \ -result [clock format 0 -locale current -timezone EST5 \ -format {%l:%M:%S %p %Z}] @@ -36975,62 +36922,32 @@ test clock-37.3 {%Es gmt testing CEST} { test clock-38.1 {regression - convertUTCToLocalViaC - east of Greenwich} \ -setup { - if { [info exists env(TZ)] } { - set oldTZ $env(TZ) - } set env(TZ) CET-01:00CEST-02:00,M3.5.0/02:00,M10.5.0/03:00 } \ -body { clock format 0 -format %H:%M:%S -timezone :localtime } \ -cleanup { - if { [info exists oldTZ] } { - set env(TZ) $oldTZ - unset oldTZ - } else { - unset env(TZ) - } + unset -nocomplain env(TZ) } \ -result {01:00:00} test clock-38.2 {make sure TZ is not cached after unset} \ - -setup { - if { [info exists env(TZ)] } { - set oldTZ $env(TZ) - unset env(TZ) - } - if { [info exists env(TCL_TZ)] } { - set oldTCLTZ $env(TCL_TZ) - unset env(TCL_TZ) - } - } \ -body { set t1 [clock format 0] # a time zone that is unlikely to anywhere set env(TZ) "+04:20" set t2 [clock format 0] - unset env(TZ) + unset -nocomplain env(TZ) set t3 [clock format 0] expr {$t1 eq $t3 && $t1 ne $t2} } \ -cleanup { - if { [info exists oldTZ] } { - set env(TZ) $oldTZ - unset oldTZ - } - if { [info exists oldTclTZ] } { - set env(TCL_TZ) $oldTclTZ - unset oldTclTZ - } + unset -nocomplain env(TZ) } \ -result 1 test clock-38.3sc {ensure cache of base is correct for :localtime if TZ-env changing / scan} \ - -setup { - if { [info exists env(TZ)] } { - set oldTZ $env(TZ) - } - } \ -body { set res {} foreach env(TZ) {GMT-11:30 GMT-07:30 GMT-03:30 GMT} \ @@ -37041,20 +36958,10 @@ test clock-38.3sc {ensure cache of base is correct for :localtime if TZ-env chan set res } \ -cleanup { - if { [info exists oldTZ] } { - set env(TZ) $oldTZ - unset oldTZ - } else { - unset env(TZ) - } + unset -nocomplain env(TZ) } \ -result [lrepeat 4 [expr {20*60*60}]] test clock-38.3fm {ensure cache of base is correct for :localtime if TZ-env changing / format} \ - -setup { - if { [info exists env(TZ)] } { - set oldTZ $env(TZ) - } - } \ -body { set res {} foreach env(TZ) {GMT-11:30 GMT-07:30 GMT-03:30 GMT} { @@ -37063,12 +36970,7 @@ test clock-38.3fm {ensure cache of base is correct for :localtime if TZ-env chan set res } \ -cleanup { - if { [info exists oldTZ] } { - set env(TZ) $oldTZ - unset oldTZ - } else { - unset env(TZ) - } + unset -nocomplain env(TZ) } \ -result {{1970-01-02T07:30:00 +1130} {1970-01-02T03:30:00 +0730} {1970-01-01T23:30:00 +0330} {1970-01-01T20:00:00 +0000}} @@ -37078,9 +36980,6 @@ test clock-39.1 {regression - synonym timezones} { test clock-40.1 {regression - bad month with -timezone :localtime} \ -setup { - if { [info exists env(TZ)] } { - set oldTZ $env(TZ) - } set env(TZ) UTC0 } \ -body { @@ -37088,12 +36987,7 @@ test clock-40.1 {regression - bad month with -timezone :localtime} \ -format %Y-%m-%dT%H:%M:%S } \ -cleanup { - if { [info exists oldTZ] } { - set env(TZ) $oldTZ - unset oldTZ - } else { - unset env(TZ) - } + unset -nocomplain env(TZ) } \ -result 946684800 @@ -37103,21 +36997,13 @@ test clock-41.1 {regression test - format group %k when hour is 0 } { test clock-42.1 {regression test - %z in :localtime when west of Greenwich } \ -setup { - if { [info exists env(TZ)] } { - set oldTZ $env(TZ) - } set env(TZ) EST5 } \ -body { clock format 0 -format %z -timezone :localtime } \ -cleanup { - if { [info exists oldTZ] } { - set env(TZ) $oldTZ - unset oldTZ - } else { - unset env(TZ) - } + unset -nocomplain env(TZ) } \ -result {-0500} @@ -37125,21 +37011,13 @@ test clock-42.1 {regression test - %z in :localtime when west of Greenwich } \ test clock-44.1 {regression test - time zone name containing hyphen } \ -setup { - if { [info exists env(TZ)] } { - set oldTZ $env(TZ) - } set env(TZ) US/East-Indiana } \ -body { clock format 1098466496 -format %H:%M:%S%z -timezone US/East-Indiana } \ -cleanup { - if { [info exists oldTZ] } { - set env(TZ) $oldTZ - unset oldTZ - } else { - unset env(TZ) - } + unset -nocomplain env(TZ) } \ -result {12:34:56-0500} @@ -37558,19 +37436,7 @@ test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \ -constraints {win noappverifier} \ -setup { # override the registry so that the test takes place in New York time - namespace eval ::tcl::clock { - namespace import -force ::testClock::registry - } - set noreg [info exists ::tcl::clock::NoRegistry] - if {$noreg} {unset ::tcl::clock::NoRegistry} - if { [info exists env(TZ)] } { - set oldTZ $env(TZ) - unset env(TZ) - } - if { [info exists env(TCL_TZ)] } { - set oldTclTZ $env(TCL_TZ) - unset env(TCL_TZ) - } + ::testClock::_setupRegistry # make it so New York time is a missing file dict set ::tcl::clock::WinZoneInfo \ {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} \ @@ -37584,16 +37450,7 @@ test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \ } \ -cleanup { # restore the registry and environment - namespace eval ::tcl::clock { - rename registry {} - } - if {$noreg} {set ::tcl::clock::NoRegistry {}} - if { [info exists oldTclTZ] } { - set env(TCL_TZ) $oldTclTZ - } - if { [info exists oldTZ] } { - set env(TZ) $oldTZ - } + ::testClock::_cleanupRegistry # put New York back on the map dict set ::tcl::clock::WinZoneInfo \ {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} \ @@ -38625,8 +38482,9 @@ if {!$valid_mode && [info exists ::tcltest::skippedBecause(!valid_off)]} { incr ::tcltest::numTests(Skipped) -$::tcltest::skippedBecause(!valid_off) unset ::tcltest::skippedBecause(!valid_off) } -::tcltest::cleanupTests +::testClock::_cleanupNoTZ namespace delete ::testClock +::tcltest::cleanupTests unset valid_mode return |