1 | # TODO - When integrating this with the Core, path names will need to be |
---|
2 | # swizzled here. |
---|
3 | |
---|
4 | package require msgcat |
---|
5 | set d [file dirname [file dirname [info script]]] |
---|
6 | puts "getting transition data from [file join $d library tzdata America Detroit]" |
---|
7 | source [file join $d library/tzdata/America/Detroit] |
---|
8 | |
---|
9 | namespace 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 | |
---|
79 | proc 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 | |
---|
153 | proc 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 | |
---|
211 | proc 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 | |
---|
362 | proc 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 | |
---|
466 | proc 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 | |
---|
501 | proc 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 | |
---|
569 | proc 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 | |
---|
648 | proc 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 | |
---|
708 | proc 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 | |
---|
771 | proc 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 | |
---|
817 | proc 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 | |
---|
868 | proc 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 | |
---|
914 | proc 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 | |
---|
964 | proc 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 | |
---|
1011 | proc 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 | |
---|
1059 | proc 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 | |
---|
1108 | proc 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 | |
---|
1180 | processFile $d |
---|