back-port from core tcl (clock: load TZ failure normalization and tes…

…t coverage)
sebres · Oct 31, 2024 · 92a66db · 92a66db
1 parent 4352a8f
commit 92a66db
Show file tree

Hide file tree

Showing 2 changed files with 41 additions and 17 deletions.
diff --git a/lib/clock.tcl b/lib/clock.tcl
@@ -999,24 +999,29 @@ proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } {
 		    LoadTimeZoneFile [string range $timezone 1 end]
 		}] && [catch {
 		    LoadZoneinfoFile [string range $timezone 1 end]
-		}]
+		} ret opts]
 	    } then {
+		dict unset opts -errorinfo
+		if {[lindex [dict get $opts -errorcode] 0] ne "CLOCK"} {
+		    dict set opts -errorcode [list CLOCK badTimeZone $timezone]
+		    set ret "time zone \"$timezone\" not found: $ret"
+		}
 	    	dict set TimeZoneBad $timezone 1
-		return -code error \
-		    -errorcode [list CLOCK badTimeZone $timezone] \
-		    "time zone \"$timezone\" not found"
+		return -options $opts $ret
 	    }
 	} elseif { ![catch {ParsePosixTimeZone $timezone} tzfields] } {
 	    # This looks like a POSIX time zone - try to process it
 
-	    if { [catch {ProcessPosixTimeZone $tzfields} data opts] } {
-		if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
-		    dict unset opts -errorinfo
+	    if { [catch {ProcessPosixTimeZone $tzfields} ret opts] } {
+		dict unset opts -errorinfo
+		if {[lindex [dict get $opts -errorcode] 0] ne "CLOCK"} {
+		    dict set opts -errorcode [list CLOCK badTimeZone $timezone]
+		    set ret "time zone \"$timezone\" not found: $ret"
 		}
 		dict set TimeZoneBad $timezone 1
-		return -options $opts $data
+		return -options $opts $ret
 	    } else {
-		set TZData($timezone) $data
+		set TZData($timezone) $ret
 	    }
 
 	} else {
@@ -1027,7 +1032,7 @@ proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } {
 	    # time zone file - this time without a colon
 
 	    if { [catch { LoadTimeZoneFile $timezone }]
-		 && [catch { LoadZoneinfoFile $timezone } - opts] } {
+		 && [catch { LoadZoneinfoFile $timezone } ret opts] } {
 
 		# Check may be a legacy zone:
 
@@ -1041,8 +1046,12 @@ proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } {
 		}
 
 		dict unset opts -errorinfo
+		if {[lindex [dict get $opts -errorcode] 0] ne "CLOCK"} {
+		    dict set opts -errorcode [list CLOCK badTimeZone $timezone]
+		    set ret "time zone \"$timezone\" not found: $ret"
+		}
 		dict set TimeZoneBad $timezone 1
-		return -options $opts "time zone $timezone not found"
+		return -options $opts $ret
 	    }
 	    set TZData($timezone) $TZData(:$timezone)
 	}
@@ -1224,7 +1233,7 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
 
     if { [regexp {^[/\\]|^[a-zA-Z]+:|(?:^|[/\\])\.\.} $fileName] } {
 	return -code error \
-	    -errorcode [list CLOCK badTimeZone $:fileName] \
+	    -errorcode [list CLOCK badTimeZone :$fileName] \
 	    "time zone \":$fileName\" not valid"
     }
     try {
@@ -1264,15 +1273,21 @@ proc ::tcl::clock::LoadZoneinfoFile { fileName } {
 
     if { [regexp {^[/\\]|^[a-zA-Z]+:|(?:^|[/\\])\.\.} $fileName] } {
 	return -code error \
-	    -errorcode [list CLOCK badTimeZone $:fileName] \
+	    -errorcode [list CLOCK badTimeZone :$fileName] \
 	    "time zone \":$fileName\" not valid"
     }
+    set fname ""
     foreach d $ZoneinfoPaths {
 	set fname [file join $d $fileName]
 	if { [file readable $fname] && [file isfile $fname] } {
 	    break
 	}
-	unset fname
+	set fname ""
+    }
+    if {$fname eq ""} {
+	return -code error \
+	    -errorcode [list CLOCK badTimeZone :$fileName] \
+	    "time zone \":$fileName\" not found"
     }
     ReadZoneinfoFile $fileName $fname
 }

diff --git a/tests/clock.test b/tests/clock.test
@@ -337,9 +337,18 @@ test clock-1.4.1 "clock format - unexpected option for this sub-command" {
     list [catch {clock format 0 -base 0} msg] $msg $::errorCode
 } [subst {1 {bad option "-base": should be "$syntax"} {CLOCK badOption -base}}]
 
-test clock-1.5 "clock format - bad timezone" {
-    list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode
-} {1 {time zone ":NOWHERE" not found} {CLOCK badTimeZone :NOWHERE}}
+test clock-1.5 "clock format - bad timezone" -body {
+    clock format 0 -format "%s" -timezone :NOWHERE
+} -returnCodes 1 -result {time zone ":NOWHERE" not found} -errorCode {CLOCK badTimeZone :NOWHERE}
+foreach tz [list {*}{
+  ../UNSAFEPATH/NOWHERE UNSAFEPATH/../GMT //UNSAFEPATH/NOWHERE
+  zipfs:/UNSAFEPATH/NOWHERE C:/UNSAFEPATH/NOWHERE
+  } [list $::tcl::clock::DataDir/GMT]
+] {
+test clock-1.5.1 "clock format - bad timezone" -body {
+    clock format 0 -format "%s" -timezone $tz
+} -returnCodes 1 -result "time zone \":$tz\" not valid" -errorCode [list CLOCK badTimeZone :$tz]
+}
 
 test clock-1.6 "clock format - gmt + timezone" {
     list [catch {clock format 0 -timezone :GMT -gmt true} msg] $msg $::errorCode