1# TODO - When integrating this with the Core, path names will need to be 2# swizzled here. 3 4package require msgcat 5set d [file dirname [file dirname [info script]]] 6puts "getting transition data from [file join $d library tzdata America Detroit]" 7source [file join $d library/tzdata/America/Detroit] 8 9namespace eval ::tcl::clock { 10 ::msgcat::mcmset en_US_roman { 11 LOCALE_ERAS { 12 {-62164627200 {} 0} 13 {-59008867200 c 100} 14 {-55853107200 cc 200} 15 {-52697347200 ccc 300} 16 {-49541587200 cd 400} 17 {-46385827200 d 500} 18 {-43230067200 dc 600} 19 {-40074307200 dcc 700} 20 {-36918547200 dccc 800} 21 {-33762787200 cm 900} 22 {-30607027200 m 1000} 23 {-27451267200 mc 1100} 24 {-24295507200 mcc 1200} 25 {-21139747200 mccc 1300} 26 {-17983987200 mcd 1400} 27 {-14828227200 md 1500} 28 {-11672467200 mdc 1600} 29 {-8516707200 mdcc 1700} 30 {-5364662400 mdccc 1800} 31 {-2208988800 mcm 1900} 32 {946684800 mm 2000} 33 } 34 LOCALE_NUMERALS { 35 ? i ii iii iv v vi vii viii ix 36 x xi xii xiii xiv xv xvi xvii xviii xix 37 xx xxi xxii xxiii xxiv xxv xxvi xxvii xxviii xxix 38 xxx xxxi xxxii xxxiii xxxiv xxxv xxxvi xxxvii xxxviii xxxix 39 xl xli xlii xliii xliv xlv xlvi xlvii xlviii xlix 40 l li lii liii liv lv lvi lvii lviii lix 41 lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix 42 lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix 43 lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii 44 lxxxix 45 xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix 46 c 47 } 48 DATE_FORMAT {%m/%d/%Y} 49 TIME_FORMAT {%H:%M:%S} 50 DATE_TIME_FORMAT {%x %X} 51 LOCALE_DATE_FORMAT {die %Od mensis %Om annoque %EY} 52 LOCALE_TIME_FORMAT {%OH h %OM m %OS s} 53 LOCALE_DATE_TIME_FORMAT {%Ex %EX} 54 } 55} 56 57#---------------------------------------------------------------------- 58# 59# listYears -- 60# 61# List the years to test in the common clock test cases. 62# 63# Parameters: 64# startOfYearArray - Name of an array in caller's scope that will 65# be initialized as 66# Results: 67# None 68# 69# Side effects: 70# Determines the year numbers of one common year, one leap year, one year 71# following a common year, and one year following a leap year -- starting 72# on each day of the week -- in the XIXth, XXth and XXIth centuries. 73# Initializes the given array to have keys equal to the year numbers and 74# values equal to [clock seconds] at the start of the corresponding 75# years. 76# 77#---------------------------------------------------------------------- 78 79proc listYears { startOfYearArray } { 80 81 upvar 1 $startOfYearArray startOfYear 82 83 # List years after 1970 84 85 set y 1970 86 set s 0 87 set dw 4 ;# Thursday 88 while { $y < 2100 } { 89 if { $y % 4 == 0 && $y % 100 != 0 || $y % 400 == 0 } { 90 set l 1 91 incr dw 366 92 set s2 [expr { $s + wide( 366 * 86400 ) }] 93 } else { 94 set l 0 95 incr dw 365 96 set s2 [expr { $s + wide( 365 * 86400 ) }] 97 } 98 set x [expr { $y >= 2037 }] 99 set dw [expr {$dw % 7}] 100 set c [expr { $y / 100 }] 101 if { ![info exists do($x$c$dw$l)] } { 102 set do($x$c$dw$l) $y 103 set startOfYear($y) $s 104 set startOfYear([expr {$y + 1}]) $s2 105 } 106 set s $s2 107 incr y 108 } 109 110 # List years before 1970 111 112 set y 1970 113 set s 0 114 set dw 4; # Thursday 115 while { $y >= 1801 } { 116 set s0 $s 117 incr dw 371 118 incr y -1 119 if { $y % 4 == 0 && $y % 100 != 0 || $y % 400 == 0 } { 120 set l 1 121 incr dw -366 122 set s [expr { $s - wide(366 * 86400) }] 123 } else { 124 set l 0 125 incr dw -365 126 set s [expr { $s - wide(365 * 86400) }] 127 } 128 set dw [expr {$dw % 7}] 129 set c [expr { $y / 100 }] 130 if { ![info exists do($c$dw$l)] } { 131 set do($c$dw$l) $y 132 set startOfYear($y) $s 133 set startOfYear([expr {$y + 1}]) $s0 134 } 135 } 136 137} 138 139#---------------------------------------------------------------------- 140# 141# processFile - 142# 143# Processes the 'clock.test' file, updating the test cases in it. 144# 145# Parameters: 146# None. 147# 148# Side effects: 149# Replaces the file with a new copy, constructing needed test cases. 150# 151#---------------------------------------------------------------------- 152 153proc processFile {d} { 154 155 # Open two files 156 157 set f1 [open [file join $d tests/clock.test] r] 158 set f2 [open [file join $d tests/clock.new] w] 159 160 # Copy leading portion of the test file 161 162 set state {} 163 while { [gets $f1 line] >= 0 } { 164 switch -exact -- $state { 165 {} { 166 puts $f2 $line 167 if { [regexp "^\# BEGIN (.*)" $line -> cases] 168 && [string compare {} [info commands $cases]] } { 169 set state inCaseSet 170 $cases $f2 171 } 172 } 173 inCaseSet { 174 if { [regexp "^\#\ END $cases\$" $line] } { 175 puts $f2 $line 176 set state {} 177 } 178 } 179 } 180 } 181 182 # Rotate the files 183 184 close $f1 185 close $f2 186 file delete -force [file join $d tests/clock.bak] 187 file rename -force [file join $d tests/clock.test] \ 188 [file join $d tests/clock.bak] 189 file rename [file join $d tests/clock.new] [file join $d tests/clock.test] 190 191} 192 193#---------------------------------------------------------------------- 194# 195# testcases2 -- 196# 197# Outputs the 'clock-2.x' test cases. 198# 199# Parameters: 200# f2 -- Channel handle to the output file 201# 202# Results: 203# None. 204# 205# Side effects: 206# Test cases for formatting in Gregorian calendar are written to the 207# output file. 208# 209#---------------------------------------------------------------------- 210 211proc testcases2 { f2 } { 212 213 listYears startOfYear 214 215 # Define the roman numerals 216 217 set roman { 218 ? i ii iii iv v vi vii viii ix 219 x xi xii xiii xiv xv xvi xvii xviii xix 220 xx xxi xxii xxiii xxiv xxv xxvi xxvii xxviii xxix 221 xxx xxxi xxxii xxxiii xxxiv xxxv xxxvi xxxvii xxxviii xxxix 222 xl xli xlii xliii xliv xlv xlvi xlvii xlviii xlix 223 l li lii liii liv lv lvi lvii lviii lix 224 lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix 225 lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix 226 lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii lxxxix 227 xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix 228 c 229 } 230 set romanc { 231 ? c cc ccc cd d dc dcc dccc cm 232 m mc mcc mccc mcd md mdc mdcc mdccc mcm 233 mm mmc mmcc mmccc mmcd mmd mmdc mmdcc mmdccc mmcm 234 mmm mmmc mmmcc mmmccc mmmcd mmmd mmmdc mmmdcc mmmdccc mmmcm 235 } 236 237 # Names of the months 238 239 set short {{} Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec} 240 set long { 241 {} January February March April May June July August September 242 October November December 243 } 244 245 # Put out a header describing the tests 246 247 puts $f2 "" 248 puts $f2 "\# Test formatting of Gregorian year, month, day, all formats" 249 puts $f2 "\# Formats tested: %b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y %EY" 250 puts $f2 "" 251 252 # Generate the test cases for the first and last day of every month 253 # from 1896 to 2045 254 255 set n 0 256 foreach { y } [lsort -integer [array names startOfYear]] { 257 set s [expr { $startOfYear($y) + wide(12*3600 + 34*60 + 56) }] 258 set m 0 259 set yd 1 260 foreach hath { 31 28 31 30 31 30 31 31 30 31 30 31 } { 261 incr m 262 if { $m == 2 && ( $y%4 == 0 && $y%100 != 0 || $y%400 == 0 ) } { 263 incr hath 264 } 265 266 set b [lindex $short $m] 267 set B [lindex $long $m] 268 set C [format %02d [expr { $y / 100 }]] 269 set h $b 270 set j [format %03d $yd] 271 set mm [format %02d $m] 272 set N [format %2d $m] 273 set yy [format %02d [expr { $y % 100 }]] 274 275 set J [expr { ( $s / 86400 ) + 2440588 }] 276 277 set dt $y-$mm-01 278 set result "" 279 append result $b " " $B " " \ 280 $mm /01/ $y " 12:34:56 " \ 281 "die i mensis " [lindex $roman $m] " annoque " \ 282 [lindex $romanc [expr { $y / 100 }]] \ 283 [lindex $roman [expr { $y % 100 }]] " " \ 284 [lindex $roman 12] " h " [lindex $roman 34] " m " \ 285 [lindex $roman 56] " s " \ 286 $C " " [lindex $romanc [expr { $y / 100 }]] \ 287 " 01 i 1 i " \ 288 $h " " $j " " $J " " $mm " " [lindex $roman $m] " " $N \ 289 " " $mm "/01/" $y \ 290 " die i mensis " [lindex $roman $m] " annoque " \ 291 [lindex $romanc [expr { $y / 100 }]] \ 292 [lindex $roman [expr { $y % 100 }]] \ 293 " " $yy " " [lindex $roman [expr { $y % 100 }]] " " $y 294 puts $f2 "test clock-2.[incr n] {conversion of $dt} {" 295 puts $f2 " clock format $s \\" 296 puts $f2 "\t-format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \\" 297 puts $f2 "\t-gmt true -locale en_US_roman" 298 puts $f2 "} {$result}" 299 300 set hm1 [expr { $hath - 1 }] 301 incr s [expr { 86400 * ( $hath - 1 ) }] 302 incr yd $hm1 303 304 set dd [format %02d $hath] 305 set ee [format %2d $hath] 306 set j [format %03d $yd] 307 308 set J [expr { ( $s / 86400 ) + 2440588 }] 309 310 set dt $y-$mm-$dd 311 set result "" 312 append result $b " " $B " " \ 313 $mm / $dd / $y " 12:34:56 " \ 314 "die " [lindex $roman $hath] " mensis " [lindex $roman $m] \ 315 " annoque " \ 316 [lindex $romanc [expr { $y / 100 }]] \ 317 [lindex $roman [expr { $y % 100 }]] " " \ 318 [lindex $roman 12] " h " [lindex $roman 34] " m " \ 319 [lindex $roman 56] " s " \ 320 $C " " [lindex $romanc [expr { $y / 100 }]] \ 321 " " $dd " " [lindex $roman $hath] " " \ 322 $ee " " [lindex $roman $hath] " "\ 323 $h " " $j " " $J " " $mm " " [lindex $roman $m] " " $N \ 324 " " $mm "/" $dd "/" $y \ 325 " die " [lindex $roman $hath] " mensis " [lindex $roman $m] \ 326 " annoque " \ 327 [lindex $romanc [expr { $y / 100 }]] \ 328 [lindex $roman [expr { $y % 100 }]] \ 329 " " $yy " " [lindex $roman [expr { $y % 100 }]] " " $y 330 puts $f2 "test clock-2.[incr n] {conversion of $dt} {" 331 puts $f2 " clock format $s \\" 332 puts $f2 "\t-format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \\" 333 puts $f2 "\t-gmt true -locale en_US_roman" 334 puts $f2 "} {$result}" 335 336 incr s 86400 337 incr yd 338 } 339 } 340 puts "testcases2: $n test cases" 341} 342 343#---------------------------------------------------------------------- 344# 345# testcases3 -- 346# 347# Generate test cases for ISO8601 calendar. 348# 349# Parameters: 350# f2 - Channel handle to the output file 351# 352# Results: 353# None 354# 355# Side effects: 356# Makes a test case for the first and last day of weeks 51, 52, and 1 357# plus the first and last day of a year. Does so for each possible 358# weekday on which a Common Year or Leap Year can begin. 359# 360#---------------------------------------------------------------------- 361 362proc testcases3 { f2 } { 363 364 listYears startOfYear 365 366 set case 0 367 foreach { y } [lsort -integer [array names startOfYear]] { 368 set secs $startOfYear($y) 369 set ym1 [expr { $y - 1 }] 370 set dow [expr { ( $secs / 86400 + 4 ) % 7}] 371 switch -exact $dow { 372 0 { 373 # Year starts on a Sunday. 374 # Prior year started on a Friday or Saturday, and was 375 # a 52-week year. 376 # 1 January is ISO week 52 of the prior year. 2 January 377 # begins ISO week 1 of the current year. 378 # 1 January is week 1 according to %U. According to %W, 379 # week 1 begins on 2 January 380 testISO $f2 $ym1 52 1 [expr { $secs - 6*86400 }] 381 testISO $f2 $ym1 52 6 [expr { $secs - 86400 }] 382 testISO $f2 $ym1 52 7 $secs 383 testISO $f2 $y 1 1 [expr { $secs + 86400 }] 384 testISO $f2 $y 1 6 [expr { $secs + 6*86400}] 385 testISO $f2 $y 1 7 [expr { $secs + 7*86400 }] 386 testISO $f2 $y 2 1 [expr { $secs + 8*86400 }] 387 } 388 1 { 389 # Year starts on a Monday. 390 # Previous year started on a Saturday or Sunday, and was 391 # a 52-week year. 392 # 1 January is ISO week 1 of the current year 393 # According to %U, it's week 0 until 7 January 394 # 1 January is week 1 according to %W 395 testISO $f2 $ym1 52 1 [expr { $secs - 7*86400 }] 396 testISO $f2 $ym1 52 6 [expr {$secs - 2*86400}] 397 testISO $f2 $ym1 52 7 [expr { $secs - 86400 }] 398 testISO $f2 $y 1 1 $secs 399 testISO $f2 $y 1 6 [expr {$secs + 5*86400}] 400 testISO $f2 $y 1 7 [expr { $secs + 6*86400 }] 401 testISO $f2 $y 2 1 [expr { $secs + 7*86400 }] 402 } 403 2 { 404 # Year starts on a Tuesday. 405 testISO $f2 $ym1 52 1 [expr { $secs - 8*86400 }] 406 testISO $f2 $ym1 52 6 [expr {$secs - 3*86400}] 407 testISO $f2 $ym1 52 7 [expr { $secs - 2*86400 }] 408 testISO $f2 $y 1 1 [expr { $secs - 86400 }] 409 testISO $f2 $y 1 2 $secs 410 testISO $f2 $y 1 6 [expr {$secs + 4*86400}] 411 testISO $f2 $y 1 7 [expr { $secs + 5*86400 }] 412 testISO $f2 $y 2 1 [expr { $secs + 6*86400 }] 413 } 414 3 { 415 testISO $f2 $ym1 52 1 [expr { $secs - 9*86400 }] 416 testISO $f2 $ym1 52 6 [expr {$secs - 4*86400}] 417 testISO $f2 $ym1 52 7 [expr { $secs - 3*86400 }] 418 testISO $f2 $y 1 1 [expr { $secs - 2*86400 }] 419 testISO $f2 $y 1 3 $secs 420 testISO $f2 $y 1 6 [expr {$secs + 3*86400}] 421 testISO $f2 $y 1 7 [expr { $secs + 4*86400 }] 422 testISO $f2 $y 2 1 [expr { $secs + 5*86400 }] 423 } 424 4 { 425 testISO $f2 $ym1 52 1 [expr { $secs - 10*86400 }] 426 testISO $f2 $ym1 52 6 [expr {$secs - 5*86400}] 427 testISO $f2 $ym1 52 7 [expr { $secs - 4*86400 }] 428 testISO $f2 $y 1 1 [expr { $secs - 3*86400 }] 429 testISO $f2 $y 1 4 $secs 430 testISO $f2 $y 1 6 [expr {$secs + 2*86400}] 431 testISO $f2 $y 1 7 [expr { $secs + 3*86400 }] 432 testISO $f2 $y 2 1 [expr { $secs + 4*86400 }] 433 } 434 5 { 435 testISO $f2 $ym1 53 1 [expr { $secs - 4*86400 }] 436 testISO $f2 $ym1 53 5 $secs 437 testISO $f2 $ym1 53 6 [expr {$secs + 86400}] 438 testISO $f2 $ym1 53 7 [expr { $secs + 2*86400 }] 439 testISO $f2 $y 1 1 [expr { $secs + 3*86400 }] 440 testISO $f2 $y 1 6 [expr {$secs + 8*86400}] 441 testISO $f2 $y 1 7 [expr { $secs + 9*86400 }] 442 testISO $f2 $y 2 1 [expr { $secs + 10*86400 }] 443 } 444 6 { 445 # messy case because previous year may have had 52 or 53 weeks 446 if { $y%4 == 1 } { 447 testISO $f2 $ym1 53 1 [expr { $secs - 5*86400 }] 448 testISO $f2 $ym1 53 6 $secs 449 testISO $f2 $ym1 53 7 [expr { $secs + 86400 }] 450 } else { 451 testISO $f2 $ym1 52 1 [expr { $secs - 5*86400 }] 452 testISO $f2 $ym1 52 6 $secs 453 testISO $f2 $ym1 52 7 [expr { $secs + 86400 }] 454 } 455 testISO $f2 $y 1 1 [expr { $secs + 2*86400 }] 456 testISO $f2 $y 1 6 [expr { $secs + 7*86400 }] 457 testISO $f2 $y 1 7 [expr { $secs + 8*86400 }] 458 testISO $f2 $y 2 1 [expr { $secs + 9*86400 }] 459 } 460 } 461 } 462 puts "testcases3: $case test cases." 463 464} 465 466proc testISO { f2 G V u secs } { 467 468 upvar 1 case case 469 470 set longdays {Sunday Monday Tuesday Wednesday Thursday Friday Saturday Sunday} 471 set shortdays {Sun Mon Tue Wed Thu Fri Sat Sun} 472 473 puts $f2 "test clock-3.[incr case] {ISO week-based calendar [format %04d-W%02d-%d $G $V $u]} {" 474 puts $f2 " clock format $secs -format {%a %A %g %G %u %U %V %w %W} -gmt true; \# $G-W[format %02d $V]-$u" 475 puts $f2 "} {[lindex $shortdays $u] [lindex $longdays $u]\ 476 [format %02d [expr { $G % 100 }]] $G\ 477 $u\ 478 [clock format $secs -format %U -gmt true]\ 479 [format %02d $V] [expr { $u % 7 }]\ 480 [clock format $secs -format %W -gmt true]}" 481 482} 483 484#---------------------------------------------------------------------- 485# 486# testcases4 -- 487# 488# Makes the test cases that test formatting of time of day. 489# 490# Parameters: 491# f2 - Channel handle to the output file 492# 493# Results: 494# None. 495# 496# Side effects: 497# Writes test cases to the output. 498# 499#---------------------------------------------------------------------- 500 501proc testcases4 { f2 } { 502 503 puts $f2 {} 504 puts $f2 "\# Test formatting of time of day" 505 puts $f2 "\# Format groups tested: %H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+" 506 puts $f2 {} 507 508 set i 0 509 set fmt "%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+" 510 foreach { h romanH I romanI am } { 511 0 ? 12 xii AM 512 1 i 1 i AM 513 11 xi 11 xi AM 514 12 xii 12 xii PM 515 13 xiii 1 i PM 516 23 xxiii 11 xi PM 517 } { 518 set hh [format %02d $h] 519 set II [format %02d $I] 520 set hs [format %2d $h] 521 set Is [format %2d $I] 522 foreach { m romanM } { 0 ? 1 i 58 lviii 59 lix } { 523 set mm [format %02d $m] 524 foreach { s romanS } { 0 ? 1 i 58 lviii 59 lix } { 525 set ss [format %02d $s] 526 set x [expr { ( $h * 60 + $m ) * 60 + $s }] 527 set result "" 528 append result $hh " " $romanH " " $II " " $romanI " " \ 529 $hs " " $romanH " " $Is " " $romanI " " $mm " " $romanM " " \ 530 $am " " [string tolower $am] " " \ 531 $II ":" $mm ":" $ss " " [string tolower $am] " " \ 532 $hh ":" $mm " " \ 533 $ss " " $romanS " " \ 534 $hh ":" $mm ":" $ss " " \ 535 $hh ":" $mm ":" $ss " " \ 536 $romanH " h " $romanM " m " $romanS " s " \ 537 "Thu Jan 1 " $hh : $mm : $ss " GMT 1970" 538 puts $f2 "test clock-4.[incr i] { format time of day $hh:$mm:$ss } {" 539 puts $f2 " clock format $x \\" 540 puts $f2 " -format [list $fmt] \\" 541 puts $f2 " -locale en_US_roman \\" 542 puts $f2 " -gmt true" 543 puts $f2 "} {$result}" 544 } 545 } 546 } 547 548 puts "testcases4: $i test cases." 549} 550 551#---------------------------------------------------------------------- 552# 553# testcases5 -- 554# 555# Generates the test cases for Daylight Saving Time 556# 557# Parameters: 558# f2 - Channel handle for the input file 559# 560# Results: 561# None. 562# 563# Side effects: 564# Makes test cases for each known or anticipated time change 565# in Detroit. 566# 567#---------------------------------------------------------------------- 568 569proc testcases5 { f2 } { 570 variable TZData 571 572 puts $f2 {} 573 puts $f2 "\# Test formatting of Daylight Saving Time" 574 puts $f2 {} 575 576 set fmt {%H:%M:%S %z %Z} 577 578 set i 0 579 puts $f2 "test clock-5.[incr i] {does Detroit exist} {" 580 puts $f2 " clock format 0 -format {} -timezone :America/Detroit" 581 puts $f2 " concat" 582 puts $f2 "} {}" 583 puts $f2 "test clock-5.[incr i] {does Detroit have a Y2038 problem} detroit {" 584 puts $f2 " if { \[clock format 2158894800 -format %z -timezone :America/Detroit\] ne {-0400} } {" 585 puts $f2 " concat {y2038 problem}" 586 puts $f2 " } else {" 587 puts $f2 " concat {ok}" 588 puts $f2 " }" 589 puts $f2 "} ok" 590 591 foreach row $TZData(:America/Detroit) { 592 foreach { t offset isdst tzname } $row break 593 if { $t > -4000000000000 } { 594 set conds [list detroit] 595 if { $t > wide(0x7FFFFFFF) } { 596 set conds [list detroit y2038] 597 } 598 incr t -1 599 set x [clock format $t -format {%Y-%m-%d %H:%M:%S} \ 600 -timezone :America/Detroit] 601 set r [clock format $t -format $fmt \ 602 -timezone :America/Detroit] 603 puts $f2 "test clock-5.[incr i] {time zone boundary case $x} [list $conds] {" 604 puts $f2 " clock format $t -format [list $fmt] \\" 605 puts $f2 " -timezone :America/Detroit" 606 puts $f2 "} [list $r]" 607 incr t 608 set x [clock format $t -format {%Y-%m-%d %H:%M:%S} \ 609 -timezone :America/Detroit] 610 set r [clock format $t -format $fmt \ 611 -timezone :America/Detroit] 612 puts $f2 "test clock-5.[incr i] {time zone boundary case $x} [list $conds] {" 613 puts $f2 " clock format $t -format [list $fmt] \\" 614 puts $f2 " -timezone :America/Detroit" 615 puts $f2 "} [list $r]" 616 incr t 617 set x [clock format $t -format {%Y-%m-%d %H:%M:%S} \ 618 -timezone :America/Detroit] 619 set r [clock format $t -format $fmt \ 620 -timezone :America/Detroit] 621 puts $f2 "test clock-5.[incr i] {time zone boundary case $x} [list $conds] {" 622 puts $f2 " clock format $t -format [list $fmt] \\" 623 puts $f2 " -timezone :America/Detroit" 624 puts $f2 "} [list $r]" 625 } 626 } 627 puts "testcases5: $i test cases" 628} 629 630#---------------------------------------------------------------------- 631# 632# testcases8 -- 633# 634# Outputs the 'clock-8.x' test cases. 635# 636# Parameters: 637# f2 -- Channel handle to the output file 638# 639# Results: 640# None. 641# 642# Side effects: 643# Test cases for parsing dates in ccyymmdd format are written to the 644# output file. 645# 646#---------------------------------------------------------------------- 647 648proc testcases8 { f2 } { 649 650 # Put out a header describing the tests 651 652 puts $f2 "" 653 puts $f2 "\# Test parsing of ccyymmdd" 654 puts $f2 "" 655 656 set n 0 657 foreach year {1970 1971 2000 2001} { 658 foreach month {01 12} { 659 foreach day {02 31} { 660 set scanned [clock scan $year$month$day -gmt true] 661 foreach ccyy {%C%y %Y} { 662 foreach mm {%b %B %h %m %Om %N} { 663 foreach dd {%d %Od %e %Oe} { 664 set string [clock format $scanned \ 665 -format "$ccyy $mm $dd" \ 666 -locale en_US_roman \ 667 -gmt true] 668 puts $f2 "test clock-8.[incr n] {parse ccyymmdd} {" 669 puts $f2 " [list clock scan $string -format [list $ccyy $mm $dd] -locale en_US_roman -gmt 1]" 670 puts $f2 "} $scanned" 671 } 672 } 673 } 674 foreach fmt {%x %D} { 675 set string [clock format $scanned \ 676 -format $fmt \ 677 -locale en_US_roman \ 678 -gmt true] 679 puts $f2 "test clock-8.[incr n] {parse ccyymmdd} {" 680 puts $f2 " [list clock scan $string -format $fmt -locale en_US_roman -gmt 1]" 681 puts $f2 "} $scanned" 682 } 683 } 684 } 685 } 686 687 puts "testcases8: $n test cases" 688} 689 690#---------------------------------------------------------------------- 691# 692# testcases11 -- 693# 694# Outputs the 'clock-11.x' test cases. 695# 696# Parameters: 697# f2 -- Channel handle to the output file 698# 699# Results: 700# None. 701# 702# Side effects: 703# Test cases for precedence among YYYYMMDD and YYYYDDD are written 704# to f2. 705# 706#---------------------------------------------------------------------- 707 708proc testcases11 { f2 } { 709 710 # Put out a header describing the tests 711 712 puts $f2 "" 713 puts $f2 "\# Test precedence among yyyymmdd and yyyyddd" 714 puts $f2 "" 715 716 array set v { 717 Y 1970 718 m 01 719 d 01 720 j 002 721 } 722 723 set n 0 724 725 foreach {a b c d} { 726 Y m d j m Y d j d Y m j j Y m d 727 Y m j d m Y j d d Y j m j Y d m 728 Y d m j m d Y j d m Y j j m Y d 729 Y d j m m d j Y d m j Y j m d Y 730 Y j m d m j Y d d j Y m j d Y m 731 Y j d m m j d Y d j m Y j d m Y 732 } { 733 foreach x [list $a $b $c $d] { 734 switch -exact -- $x { 735 m - d { 736 set value 0 737 } 738 j { 739 set value 86400 740 } 741 } 742 } 743 set format "%$a%$b%$c%$d" 744 set string "$v($a)$v($b)$v($c)$v($d)" 745 puts $f2 "test clock-11.[incr n] {precedence of ccyyddd and ccyymmdd} {" 746 puts $f2 " [list clock scan $string -format $format -gmt 1]" 747 puts $f2 "} $value" 748 } 749 750 puts "testcases11: $n test cases" 751} 752 753#---------------------------------------------------------------------- 754# 755# testcases12 -- 756# 757# Outputs the 'clock-12.x' test cases, parsing CCyyWwwd 758# 759# Parameters: 760# f2 -- Channel handle to the output file 761# 762# Results: 763# None. 764# 765# Side effects: 766# Test cases for parsing dates in Gregorian calendar are written to the 767# output file. 768# 769#---------------------------------------------------------------------- 770 771proc testcases12 { f2 } { 772 773 # Put out a header describing the tests 774 775 puts $f2 "" 776 puts $f2 "\# Test parsing of ccyyWwwd" 777 puts $f2 "" 778 779 set n 0 780 foreach year {1970 1971 2000 2001} { 781 foreach month {01 12} { 782 foreach day {02 31} { 783 set scanned [clock scan $year$month$day -gmt true] 784 foreach d {%a %A %u %w %Ou %Ow} { 785 set string [clock format $scanned \ 786 -format "%G W%V $d" \ 787 -locale en_US_roman \ 788 -gmt true] 789 puts $f2 "test clock-12.[incr n] {parse ccyyWwwd} {" 790 puts $f2 " [list clock scan $string -format [list %G W%V $d] -locale en_US_roman -gmt 1]" 791 puts $f2 "} $scanned" 792 } 793 } 794 } 795 } 796 797 puts "testcases12: $n test cases" 798} 799 800#---------------------------------------------------------------------- 801# 802# testcases14 -- 803# 804# Outputs the 'clock-14.x' test cases. 805# 806# Parameters: 807# f2 -- Channel handle to the output file 808# 809# Results: 810# None. 811# 812# Side effects: 813# Test cases for parsing yymmdd dates are output. 814# 815#---------------------------------------------------------------------- 816 817proc testcases14 { f2 } { 818 819 # Put out a header describing the tests 820 821 puts $f2 "" 822 puts $f2 "\# Test parsing of yymmdd" 823 puts $f2 "" 824 825 set n 0 826 foreach year {1938 1970 2000 2037} { 827 foreach month {01 12} { 828 foreach day {02 31} { 829 set scanned [clock scan $year$month$day -gmt true] 830 foreach yy {%y %Oy} { 831 foreach mm {%b %B %h %m %Om %N} { 832 foreach dd {%d %Od %e %Oe} { 833 set string [clock format $scanned \ 834 -format "$yy $mm $dd" \ 835 -locale en_US_roman \ 836 -gmt true] 837 puts $f2 "test clock-14.[incr n] {parse yymmdd} {" 838 puts $f2 " [list clock scan $string -format [list $yy $mm $dd] -locale en_US_roman -gmt 1]" 839 puts $f2 "} $scanned" 840 } 841 } 842 } 843 } 844 } 845 } 846 847 puts "testcases14: $n test cases" 848} 849 850#---------------------------------------------------------------------- 851# 852# testcases17 -- 853# 854# Outputs the 'clock-17.x' test cases, parsing yyWwwd 855# 856# Parameters: 857# f2 -- Channel handle to the output file 858# 859# Results: 860# None. 861# 862# Side effects: 863# Test cases for parsing dates in Gregorian calendar are written to the 864# output file. 865# 866#---------------------------------------------------------------------- 867 868proc testcases17 { f2 } { 869 870 # Put out a header describing the tests 871 872 puts $f2 "" 873 puts $f2 "\# Test parsing of yyWwwd" 874 puts $f2 "" 875 876 set n 0 877 foreach year {1970 1971 2000 2001} { 878 foreach month {01 12} { 879 foreach day {02 31} { 880 set scanned [clock scan $year$month$day -gmt true] 881 foreach d {%a %A %u %w %Ou %Ow} { 882 set string [clock format $scanned \ 883 -format "%g W%V $d" \ 884 -locale en_US_roman \ 885 -gmt true] 886 puts $f2 "test clock-17.[incr n] {parse yyWwwd} {" 887 puts $f2 " [list clock scan $string -format [list %g W%V $d] -locale en_US_roman -gmt 1]" 888 puts $f2 "} $scanned" 889 } 890 } 891 } 892 } 893 894 puts "testcases17: $n test cases" 895} 896 897#---------------------------------------------------------------------- 898# 899# testcases19 -- 900# 901# Outputs the 'clock-19.x' test cases. 902# 903# Parameters: 904# f2 -- Channel handle to the output file 905# 906# Results: 907# None. 908# 909# Side effects: 910# Test cases for parsing mmdd dates are output. 911# 912#---------------------------------------------------------------------- 913 914proc testcases19 { f2 } { 915 916 # Put out a header describing the tests 917 918 puts $f2 "" 919 puts $f2 "\# Test parsing of mmdd" 920 puts $f2 "" 921 922 set n 0 923 foreach year {1938 1970 2000 2037} { 924 set base [clock scan ${year}0101 -gmt true] 925 foreach month {01 12} { 926 foreach day {02 31} { 927 set scanned [clock scan $year$month$day -gmt true] 928 foreach mm {%b %B %h %m %Om %N} { 929 foreach dd {%d %Od %e %Oe} { 930 set string [clock format $scanned \ 931 -format "$mm $dd" \ 932 -locale en_US_roman \ 933 -gmt true] 934 puts $f2 "test clock-19.[incr n] {parse mmdd} {" 935 puts $f2 " [list clock scan $string -format [list $mm $dd] -locale en_US_roman -base $base -gmt 1]" 936 puts $f2 "} $scanned" 937 } 938 } 939 } 940 } 941 } 942 943 puts "testcases19: $n test cases" 944} 945 946#---------------------------------------------------------------------- 947# 948# testcases21 -- 949# 950# Outputs the 'clock-21.x' test cases, parsing Wwwd 951# 952# Parameters: 953# f2 -- Channel handle to the output file 954# 955# Results: 956# None. 957# 958# Side effects: 959# Test cases for parsing dates in Gregorian calendar are written to the 960# output file. 961# 962#---------------------------------------------------------------------- 963 964proc testcases22 { f2 } { 965 966 # Put out a header describing the tests 967 968 puts $f2 "" 969 puts $f2 "\# Test parsing of Wwwd" 970 puts $f2 "" 971 972 set n 0 973 foreach year {1970 1971 2000 2001} { 974 set base [clock scan ${year}0104 -gmt true] 975 foreach month {03 10} { 976 foreach day {01 31} { 977 set scanned [clock scan $year$month$day -gmt true] 978 foreach d {%a %A %u %w %Ou %Ow} { 979 set string [clock format $scanned \ 980 -format "W%V $d" \ 981 -locale en_US_roman \ 982 -gmt true] 983 puts $f2 "test clock-22.[incr n] {parse Wwwd} {" 984 puts $f2 " [list clock scan $string -format [list W%V $d] -locale en_US_roman -gmt 1] -base $base" 985 puts $f2 "} $scanned" 986 } 987 } 988 } 989 } 990 991 puts "testcases22: $n test cases" 992} 993 994#---------------------------------------------------------------------- 995# 996# testcases24 -- 997# 998# Outputs the 'clock-24.x' test cases. 999# 1000# Parameters: 1001# f2 -- Channel handle to the output file 1002# 1003# Results: 1004# None. 1005# 1006# Side effects: 1007# Test cases for parsing naked day of the month are output. 1008# 1009#---------------------------------------------------------------------- 1010 1011proc testcases24 { f2 } { 1012 1013 # Put out a header describing the tests 1014 1015 puts $f2 "" 1016 puts $f2 "\# Test parsing of naked day-of-month" 1017 puts $f2 "" 1018 1019 set n 0 1020 foreach year {1970 2000} { 1021 foreach month {01 12} { 1022 set base [clock scan ${year}${month}01 -gmt true] 1023 foreach day {02 28} { 1024 set scanned [clock scan $year$month$day -gmt true] 1025 foreach dd {%d %Od %e %Oe} { 1026 set string [clock format $scanned \ 1027 -format "$dd" \ 1028 -locale en_US_roman \ 1029 -gmt true] 1030 puts $f2 "test clock-24.[incr n] {parse naked day of month} {" 1031 puts $f2 " [list clock scan $string -format $dd -locale en_US_roman -base $base -gmt 1]" 1032 puts $f2 "} $scanned" 1033 } 1034 } 1035 } 1036 } 1037 1038 puts "testcases24: $n test cases" 1039} 1040 1041#---------------------------------------------------------------------- 1042# 1043# testcases26 -- 1044# 1045# Outputs the 'clock-26.x' test cases, parsing naked day of week 1046# 1047# Parameters: 1048# f2 -- Channel handle to the output file 1049# 1050# Results: 1051# None. 1052# 1053# Side effects: 1054# Test cases for parsing dates in Gregorian calendar are written to the 1055# output file. 1056# 1057#---------------------------------------------------------------------- 1058 1059proc testcases26 { f2 } { 1060 1061 # Put out a header describing the tests 1062 1063 puts $f2 "" 1064 puts $f2 "\# Test parsing of naked day of week" 1065 puts $f2 "" 1066 1067 set n 0 1068 foreach year {1970 2001} { 1069 foreach week {01 52} { 1070 set base [clock scan ${year}W${week}4 \ 1071 -format %GW%V%u -gmt true] 1072 foreach day {1 7} { 1073 set scanned [clock scan ${year}W${week}${day} \ 1074 -format %GW%V%u -gmt true] 1075 foreach d {%a %A %u %w %Ou %Ow} { 1076 set string [clock format $scanned \ 1077 -format "$d" \ 1078 -locale en_US_roman \ 1079 -gmt true] 1080 puts $f2 "test clock-26.[incr n] {parse naked day of week} {" 1081 puts $f2 " [list clock scan $string -format $d -locale en_US_roman -gmt 1] -base $base" 1082 puts $f2 "} $scanned" 1083 } 1084 } 1085 } 1086 } 1087 1088 puts "testcases26: $n test cases" 1089} 1090 1091#---------------------------------------------------------------------- 1092# 1093# testcases29 -- 1094# 1095# Makes test cases for parsing of time of day. 1096# 1097# Parameters: 1098# f2 -- Channel where tests are to be written 1099# 1100# Results: 1101# None. 1102# 1103# Side effects: 1104# Writes the tests. 1105# 1106#---------------------------------------------------------------------- 1107 1108proc testcases29 { f2 } { 1109 1110 # Put out a header describing the tests 1111 1112 puts $f2 "" 1113 puts $f2 "\# Test parsing of time of day" 1114 puts $f2 "" 1115 1116 set n 0 1117 foreach hour {0 1 11 12 13 23} \ 1118 hampm {12 1 11 12 1 11} \ 1119 lhour {? i xi xii xiii xxiii} \ 1120 lhampm {xii i xi xii i xi} \ 1121 ampmind {am am am pm pm pm} { 1122 set sphr [format %2d $hour] 1123 set 2dhr [format %02d $hour] 1124 set sphampm [format %2d $hampm] 1125 set 2dhampm [format %02d $hampm] 1126 set AMPMind [string toupper $ampmind] 1127 foreach minute {00 01 59} lminute {? i lix} { 1128 foreach second {00 01 59} lsecond {? i lix} { 1129 set time [expr { ( 60 * $hour + $minute ) * 60 + $second }] 1130 foreach {hfmt afmt} [list \ 1131 %H {} %k {} %OH {} %Ok {} \ 1132 %I %p %l %p \ 1133 %OI %p %Ol %p \ 1134 %I %P %l %P \ 1135 %OI %P %Ol %P] \ 1136 {hfld afld} [list \ 1137 $2dhr {} $sphr {} $lhour {} $lhour {} \ 1138 $2dhampm $AMPMind $sphampm $AMPMind \ 1139 $lhampm $AMPMind $lhampm $AMPMind \ 1140 $2dhampm $ampmind $sphampm $ampmind \ 1141 $lhampm $ampmind $lhampm $ampmind] \ 1142 { 1143 if { $second eq "00" } { 1144 if { $minute eq "00" } { 1145 puts $f2 "test clock-29.[incr n] {time parsing} {" 1146 puts $f2 " clock scan {2440588 $hfld $afld} \\" 1147 puts $f2 " -gmt true -locale en_US_roman \\" 1148 puts $f2 " -format {%J $hfmt $afmt}" 1149 puts $f2 "} $time" 1150 } 1151 puts $f2 "test clock-29.[incr n] {time parsing} {" 1152 puts $f2 " clock scan {2440588 $hfld:$minute $afld} \\" 1153 puts $f2 " -gmt true -locale en_US_roman \\" 1154 puts $f2 " -format {%J $hfmt:%M $afmt}" 1155 puts $f2 "} $time" 1156 puts $f2 "test clock-29.[incr n] {time parsing} {" 1157 puts $f2 " clock scan {2440588 $hfld:$lminute $afld} \\" 1158 puts $f2 " -gmt true -locale en_US_roman \\" 1159 puts $f2 " -format {%J $hfmt:%OM $afmt}" 1160 puts $f2 "} $time" 1161 } 1162 puts $f2 "test clock-29.[incr n] {time parsing} {" 1163 puts $f2 " clock scan {2440588 $hfld:$minute:$second $afld} \\" 1164 puts $f2 " -gmt true -locale en_US_roman \\" 1165 puts $f2 " -format {%J $hfmt:%M:%S $afmt}" 1166 puts $f2 "} $time" 1167 puts $f2 "test clock-29.[incr n] {time parsing} {" 1168 puts $f2 " clock scan {2440588 $hfld:$lminute:$lsecond $afld} \\" 1169 puts $f2 " -gmt true -locale en_US_roman \\" 1170 puts $f2 " -format {%J $hfmt:%OM:%OS $afmt}" 1171 puts $f2 "} $time" 1172 } 1173 } 1174 } 1175 1176 } 1177 puts "testcases29: $n test cases" 1178} 1179 1180processFile $d 1181