Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/tools/makeTestCases.tcl @ 35

Last change on this file since 35 was 25, checked in by landauf, 18 years ago

added tcl to libs
File size: 32.1 KB
RevLine 
[25]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
Note: See TracBrowser for help on using the repository browser.