Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | merge trunk |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | tip-389-impl |
| Files: | files | file ages | folders |
| SHA1: |
f07a85fee0a778f94e35666b0e57e13f |
| User & Date: | jan.nijtmans 2017-05-31 12:51:51.290 |
Context
|
2017-06-06
| ||
| 14:46 | Merge trunk check-in: b03462a529 user: jan.nijtmans tags: tip-389-impl | |
|
2017-05-31
| ||
| 12:51 | merge trunk check-in: f07a85fee0 user: jan.nijtmans tags: tip-389-impl | |
| 12:06 | merge core-8-6-branch check-in: c30eb96495 user: jan.nijtmans tags: trunk | |
|
2017-05-29
| ||
| 15:38 | merge trunk check-in: 6d946ddf77 user: jan.nijtmans tags: tip-389-impl | |
Changes
Changes to doc/clock.n.
| ︙ | ︙ | |||
83 84 85 86 87 88 89 90 91 92 93 94 95 96 | 1 January 1970, 00:00 UTC. Note that the count of seconds does not include any leap seconds; seconds are counted as if each UTC day has exactly 86400 seconds. Tcl responds to leap seconds by speeding or slowing its clock by a tiny fraction for some minutes until it is back in sync with UTC; its data model does not represent minutes that have 59 or 61 seconds. .TP \fIunit\fR One of the words, \fBseconds\fR, \fBminutes\fR, \fBhours\fR, \fBdays\fR, \fBweekdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR. Used in conjunction with \fIcount\fR to identify an interval of time, for example, \fI3 seconds\fR or \fI1 year\fR. .SS "OPTIONS" .TP | > > > > > > > > > | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | 1 January 1970, 00:00 UTC. Note that the count of seconds does not include any leap seconds; seconds are counted as if each UTC day has exactly 86400 seconds. Tcl responds to leap seconds by speeding or slowing its clock by a tiny fraction for some minutes until it is back in sync with UTC; its data model does not represent minutes that have 59 or 61 seconds. .TP \fI\-now\fR Instead of \fItimeVal\fR a non-integer option \fI\-now\fR can be used as replacement for today, which is simply interpolated to the runt-time as value of \fBclock seconds\fR. For example: .sp \fBclock format -now -f %a; # current day of the week\fR .sp \fBclock add -now 1 month; # next month\fR .TP \fIunit\fR One of the words, \fBseconds\fR, \fBminutes\fR, \fBhours\fR, \fBdays\fR, \fBweekdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR. Used in conjunction with \fIcount\fR to identify an interval of time, for example, \fI3 seconds\fR or \fI1 year\fR. .SS "OPTIONS" .TP |
| ︙ | ︙ | |||
523 524 525 526 527 528 529 530 531 532 533 534 535 536 | string of the same meaning in the locale, to indicate whether \fB%Y\fR refers to years before or after Year 1 of the Common Era. On input, accepts the string \fBB.C.E.\fR, \fBB.C.\fR, \fBC.E.\fR, \fBA.D.\fR, or the abbreviation appropriate to the current locale, and uses it to fix whether \fB%Y\fR refers to years before or after Year 1 of the Common Era. .TP \fB%Ex\fR On output, produces a locale-dependent representation of the date in the locale's alternative calendar. On input, matches whatever \fB%Ex\fR produces. The locale's alternative calendar need not be the Gregorian calendar. .TP \fB%EX\fR | > > > > > > | 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 | string of the same meaning in the locale, to indicate whether \fB%Y\fR refers to years before or after Year 1 of the Common Era. On input, accepts the string \fBB.C.E.\fR, \fBB.C.\fR, \fBC.E.\fR, \fBA.D.\fR, or the abbreviation appropriate to the current locale, and uses it to fix whether \fB%Y\fR refers to years before or after Year 1 of the Common Era. .TP \fB%Es\fR This affects similar to \fB%s\fR, but in opposition to \fB%s\fR it parses or formats local seconds (not the posix seconds). Because \fB%s\fR has the same precedence as \fB%s\fR (uniquely determines a point in time), it overrides all other input formats. .TP \fB%Ex\fR On output, produces a locale-dependent representation of the date in the locale's alternative calendar. On input, matches whatever \fB%Ex\fR produces. The locale's alternative calendar need not be the Gregorian calendar. .TP \fB%EX\fR |
| ︙ | ︙ | |||
717 718 719 720 721 722 723 | that \fB%Y\fR does not yield a year appropriate for use with the ISO8601 week number \fB%V\fR; programs should use \fB%G\fR for that purpose. .TP \fB%z\fR On output, produces the current time zone, expressed in hours and minutes east (+hhmm) or west (\-hhmm) of Greenwich. On input, accepts a time zone specifier (see \fBTIME ZONES\fR below) that will be used to | | > > | | 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 | that \fB%Y\fR does not yield a year appropriate for use with the ISO8601 week number \fB%V\fR; programs should use \fB%G\fR for that purpose. .TP \fB%z\fR On output, produces the current time zone, expressed in hours and minutes east (+hhmm) or west (\-hhmm) of Greenwich. On input, accepts a time zone specifier (see \fBTIME ZONES\fR below) that will be used to determine the time zone (this token is optionally applicable on input, so the value is not mandatory and can be missing in input). .TP \fB%Z\fR On output, produces the current time zone's name, possibly translated to the given locale. On input, accepts a time zone specifier (see \fBTIME ZONES\fR below) that will be used to determine the time zone (token is also like \fB%z\fR optionally applicable on input). This option should, in general, be used on input only when parsing RFC822 dates. Other uses are fraught with ambiguity; for instance, the string \fBBST\fR may represent British Summer Time or Brazilian Standard Time. It is recommended that date/time strings for use by computers use numeric time zones instead. .TP \fB%%\fR On output, produces a literal |
| ︙ | ︙ | |||
922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 | Using that time as the base, day-of-week specifications are added. Next, relative specifications are used. If a date or day is specified, and no absolute or relative time is given, midnight is used. Finally, a correction is applied so that the correct hour of the day is produced after allowing for daylight savings time differences and the correct date is given when going from the end of a long month to a short month. .SH "SEE ALSO" msgcat(n) .SH KEYWORDS clock, date, time .SH "COPYRIGHT" Copyright (c) 2004 Kevin B. Kenny <[email protected]>. All rights reserved. '\" Local Variables: '\" mode: nroff '\" End: | > > > > > > > > > > > > > > > > > > | 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 | Using that time as the base, day-of-week specifications are added. Next, relative specifications are used. If a date or day is specified, and no absolute or relative time is given, midnight is used. Finally, a correction is applied so that the correct hour of the day is produced after allowing for daylight savings time differences and the correct date is given when going from the end of a long month to a short month. .PP The precedence of the applying of single tokens resp. which sequence will be used by calculating of the time is complex, e. g. heavily dependent on the precision of type of the token. .sp In example below the second date-string contains "next January", therefore it results in next year but in January. And third date-string besides "January" contains also additionally "Fri", so it results in the nearest Friday. Thus both win before "385 days" resp. make it more precise, because of higher precision of this token types. .CS % clock format [clock scan "5 years 18 months 385 days" -base 0 -gmt 1] -gmt 1 Thu Jul 21 00:00:00 GMT 1977 % clock format [clock scan "5 years 18 months 385 days next January" -base 0 -gmt 1] -gmt 1 Sat Jan 21 00:00:00 GMT 1978 % clock format [clock scan "5 years 18 months 385 days next January Fri" -base 0 -gmt 1] -gmt 1 Fri Jan 27 00:00:00 GMT 1978 .CE .SH "SEE ALSO" msgcat(n) .SH KEYWORDS clock, date, time .SH "COPYRIGHT" Copyright (c) 2004 Kevin B. Kenny <[email protected]>. All rights reserved. '\" Local Variables: '\" mode: nroff '\" End: |
Added doc/timerate.n.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 |
'\"
'\" Copyright (c) 2005 Sergey Brester aka sebres.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH timerate n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
timerate \- Time-related execution resp. performance measurement of a script
.SH SYNOPSIS
\fBtimerate \fIscript\fR \fI?time?\fR
.sp
\fBtimerate \fI?-direct?\fR \fI?-overhead double?\fR \fIscript\fR \fI?time?\fR
.sp
\fBtimerate \fI?-calibrate?\fR \fI?-direct?\fR \fIscript\fR \fI?time?\fR
.BE
.SH DESCRIPTION
.PP
The first and second form will evaluate \fIscript\fR until the interval
\fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second)
if \fItime\fR is not specified.
.sp
It will then return a canonical tcl-list of the form
.PP
.CS
\f0.095977 µs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR
.CE
.PP
which indicates:
.IP \(bu
the average amount of time required per iteration, in microseconds (lindex $result 0)
.IP \(bu
the count how many times it was executed (lindex $result 2)
.IP \(bu
the estimated rate per second (lindex $result 4)
.IP \(bu
the estimated real execution time without measurement overhead (lindex $result 6)
.PP
Time is measured in elapsed time using heighest timer resolution as possible, not CPU time.
This command may be used to provide information as to how well the script or a tcl-command
is performing and can help determine bottlenecks and fine-tune application performance.
.PP
\fI-calibrate\fR
.
To measure very fast scripts as exact as posible the calibration process
may be required.
This parameter used to calibrate \fBtimerate\fR calculating the estimated overhead
of given \fIscript\fR as default overhead for further execution of \fBtimerate\fR.
It can take up to 10 seconds if parameter \fItime\fR is not specified.
.PP
\fI-overhead double\fR
.
This parameter used to supply the measurement overhead of single iteration
(in microseconds) that should be ignored during whole evaluation process.
.PP
\fI-direct\fR
.
Causes direct execution per iteration (not compiled variant of evaluation used).
.PP
In opposition to \fBtime\fR the execution limited here by fixed time instead of
repetition count.
Additionally the compiled variant of the script will be used during whole evaluation
(as if it were part of a compiled \fBproc\fR), if parameter \fI-direct\fR is not specified.
Therefore it provides more precise results and prevents very long execution time
by slow scripts resp. scripts with unknown speed.
.SH EXAMPLE
Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including
operations on variable \fIi\fR) to count to a ten:
.PP
.CS
# calibrate:
timerate -calibrate {}
# measure:
timerate { for {set i 0} {$i<10} {incr i} {} } 5000
.CE
.PP
Estimate how fast it takes for a simple Tcl \fBfor\fR loop only (ignoring the
overhead for operations on variable \fIi\fR) to count to a ten:
.PP
.CS
# calibrate for overhead of variable operations:
set i 0; timerate -calibrate {expr {$i<10}; incr i} 1000
# measure:
timerate { for {set i 0} {$i<10} {incr i} {} } 5000
.CE
.PP
Estimate the rate of calculating the hour using \fBclock format\fR only, ignoring
overhead of the rest, without measurement how fast it takes for a whole script:
.PP
.CS
# calibrate:
timerate -calibrate {}
# estimate overhead:
set tm 0
set ovh [lindex [timerate { incr tm [expr {24*60*60}] }] 0]
# measure using esimated overhead:
set tm 0
timerate -overhead $ovh {
clock format $tm -format %H
incr tm [expr {24*60*60}]; # overhead for this is ignored
} 5000
.CE
.SH "SEE ALSO"
time(n)
.SH KEYWORDS
script, timerate, time
.\" Local Variables:
.\" mode: nroff
.\" End:
|
Changes to generic/regc_locale.c.
| ︙ | ︙ | |||
189 190 191 192 193 194 195 |
{0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7},
{0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2},
{0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, {0xaa00, 0xaa28},
{0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa7e, 0xaaaf},
{0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4},
{0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26},
{0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65}, {0xab70, 0xabe2},
| | > > > > | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < | < < < < < < < < < < < < < < < < < < | < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 |
{0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7},
{0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2},
{0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, {0xaa00, 0xaa28},
{0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa7e, 0xaaaf},
{0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4},
{0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26},
{0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65}, {0xab70, 0xabe2},
{0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e},
{0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, {0xdd00, 0xdd3e},
{0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe}, {0xde00, 0xde3e},
{0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e},
{0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe}, {0xf900, 0xfa6d},
{0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28},
{0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d},
{0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, {0xfe70, 0xfe74},
{0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a}, {0xff66, 0xffbe},
{0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}
#if TCL_UTF_MAX > 4
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0},
{0x10300, 0x1031f}, {0x1032d, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
{0x10380, 0x1039d}, {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d},
{0x104b0, 0x104d3}, {0x104d8, 0x104fb}, {0x10500, 0x10527}, {0x10530, 0x10563},
{0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
{0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089e},
{0x108e0, 0x108f2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7},
{0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a60, 0x10a7c},
{0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35},
{0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48},
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x11003, 0x11037}, {0x11083, 0x110af},
{0x110d0, 0x110e8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2},
{0x111c1, 0x111c4}, {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286},
{0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de},
{0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
{0x1135d, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af},
{0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa},
{0x11700, 0x11719}, {0x118a0, 0x118df}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a83},
{0x11a86, 0x11a89}, {0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c2e},
{0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, {0x11d0b, 0x11d30}, {0x12000, 0x12399},
{0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
{0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43},
{0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
{0x17000, 0x187ec}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
{0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
{0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
{0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
{0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
{0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, {0x1d6c2, 0x1d6da},
{0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, {0x1d736, 0x1d74e},
{0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, {0x1d7aa, 0x1d7c2},
{0x1d7c4, 0x1d7cb}, {0x1e800, 0x1e8c4}, {0x1e900, 0x1e943}, {0x1ee00, 0x1ee03},
{0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f},
{0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c},
{0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9},
{0x1eeab, 0x1eebb}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
{0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d}
#endif
};
#define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange))
static const chr alphaCharTable[] = {
0xaa, 0xb5, 0xba, 0x2ec, 0x2ee, 0x376, 0x377, 0x37f, 0x386,
|
| ︙ | ︙ | |||
1261 1262 1263 1264 1265 1266 1267 |
0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7, 0x1bae,
0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f,
0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184,
0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b,
0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5,
0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
#if TCL_UTF_MAX > 4
| | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < | < < < < < < < < < < < < | < < | 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 |
0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7, 0x1bae,
0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f,
0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184,
0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b,
0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5,
0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
#if TCL_UTF_MAX > 4
,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be,
0x109bf, 0x10a00, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f, 0x11310, 0x11332,
0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, 0x118ff, 0x11a00,
0x11a3a, 0x11a50, 0x11c40, 0x11d08, 0x11d09, 0x11d46, 0x16f50, 0x16fe0, 0x16fe1,
0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22,
0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51,
0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62,
0x1ee64, 0x1ee7e
#endif
};
#define NUM_ALPHA_CHAR (sizeof(alphaCharTable)/sizeof(chr))
/*
* Unicode: control characters.
*/
static const crange controlRangeTable[] = {
{0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {0x200b, 0x200f},
{0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff},
{0xfff9, 0xfffb}
#if TCL_UTF_MAX > 4
,{0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd},
{0x100000, 0x10fffd}
#endif
};
#define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange))
static const chr controlCharTable[] = {
0xad, 0x61c, 0x6dd, 0x70f, 0x8e2, 0x180e, 0xfeff
#if TCL_UTF_MAX > 4
,0x110bd, 0xe0001
#endif
};
#define NUM_CONTROL_CHAR (sizeof(controlCharTable)/sizeof(chr))
/*
* Unicode: decimal digit characters.
|
| ︙ | ︙ | |||
1641 1642 1643 1644 1645 1646 1647 |
{0xf20, 0xf29}, {0x1040, 0x1049}, {0x1090, 0x1099}, {0x17e0, 0x17e9},
{0x1810, 0x1819}, {0x1946, 0x194f}, {0x19d0, 0x19d9}, {0x1a80, 0x1a89},
{0x1a90, 0x1a99}, {0x1b50, 0x1b59}, {0x1bb0, 0x1bb9}, {0x1c40, 0x1c49},
{0x1c50, 0x1c59}, {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909},
{0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9},
{0xff10, 0xff19}
#if TCL_UTF_MAX > 4
| < < < < | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 |
{0xf20, 0xf29}, {0x1040, 0x1049}, {0x1090, 0x1099}, {0x17e0, 0x17e9},
{0x1810, 0x1819}, {0x1946, 0x194f}, {0x19d0, 0x19d9}, {0x1a80, 0x1a89},
{0x1a90, 0x1a99}, {0x1b50, 0x1b59}, {0x1bb0, 0x1bb9}, {0x1c40, 0x1c49},
{0x1c50, 0x1c59}, {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909},
{0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9},
{0xff10, 0xff19}
#if TCL_UTF_MAX > 4
,{0x104a0, 0x104a9}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f},
{0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459}, {0x114d0, 0x114d9},
{0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739}, {0x118e0, 0x118e9},
{0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x16a60, 0x16a69}, {0x16b50, 0x16b59},
{0x1d7ce, 0x1d7ff}, {0x1e950, 0x1e959}
#endif
};
#define NUM_DIGIT_RANGE (sizeof(digitRangeTable)/sizeof(crange))
/*
* no singletons of digit characters.
|
| ︙ | ︙ | |||
1818 1819 1820 1821 1822 1823 1824 |
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e49},
{0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f},
{0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd},
{0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61},
{0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d},
{0xff5f, 0xff65}
#if TCL_UTF_MAX > 4
| < < | | < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < | | < < < | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 |
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e49},
{0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f},
{0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd},
{0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61},
{0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d},
{0xff5f, 0xff65}
#if TCL_UTF_MAX > 4
,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f},
{0x10b99, 0x10b9c}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143},
{0x111c5, 0x111c9}, {0x111dd, 0x111df}, {0x11238, 0x1123d}, {0x1144b, 0x1144f},
{0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c}, {0x1173c, 0x1173e},
{0x11a3f, 0x11a46}, {0x11a9a, 0x11a9c}, {0x11a9e, 0x11aa2}, {0x11c41, 0x11c45},
{0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x1da87, 0x1da8b}
#endif
};
#define NUM_PUNCT_RANGE (sizeof(punctRangeTable)/sizeof(crange))
static const chr punctCharTable[] = {
0x3a, 0x3b, 0x3f, 0x40, 0x5f, 0x7b, 0x7d, 0xa1, 0xa7,
0xab, 0xb6, 0xb7, 0xbb, 0xbf, 0x37e, 0x387, 0x589, 0x58a,
0x5be, 0x5c0, 0x5c3, 0x5c6, 0x5f3, 0x5f4, 0x609, 0x60a, 0x60c,
0x60d, 0x61b, 0x61e, 0x61f, 0x6d4, 0x85e, 0x964, 0x965, 0x970,
0x9fd, 0xaf0, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14, 0xf85, 0xfd9,
0xfda, 0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c, 0x1735, 0x1736,
0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3, 0x207d, 0x207e,
0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc, 0x29fd, 0x2cfe,
0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe, 0xa4ff, 0xa673,
0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df,
0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68,
0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
#if TCL_UTF_MAX > 4
,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc,
0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x11c70,
0x11c71, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f, 0x1e95e, 0x1e95f
#endif
};
#define NUM_PUNCT_CHAR (sizeof(punctCharTable)/sizeof(chr))
/*
* Unicode: white space characters.
*/
static const crange spaceRangeTable[] = {
{0x9, 0xd}, {0x2000, 0x200b}
};
#define NUM_SPACE_RANGE (sizeof(spaceRangeTable)/sizeof(crange))
static const chr spaceCharTable[] = {
0x20, 0x85, 0xa0, 0x1680, 0x180e, 0x2028, 0x2029, 0x202f, 0x205f,
0x2060, 0x3000, 0xfeff
};
#define NUM_SPACE_CHAR (sizeof(spaceCharTable)/sizeof(chr))
/*
* Unicode: lowercase characters.
*/
|
| ︙ | ︙ | |||
2316 2317 2318 2319 2320 2321 2322 |
{0x1f70, 0x1f7d}, {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7},
{0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7},
{0x1ff2, 0x1ff4}, {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b},
{0x2d00, 0x2d25}, {0xa72f, 0xa731}, {0xa771, 0xa778}, {0xa793, 0xa795},
{0xab30, 0xab5a}, {0xab60, 0xab65}, {0xab70, 0xabbf}, {0xfb00, 0xfb06},
{0xfb13, 0xfb17}, {0xff41, 0xff5a}
#if TCL_UTF_MAX > 4
| | | | < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < | | < < < < < < < | 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 |
{0x1f70, 0x1f7d}, {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7},
{0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7},
{0x1ff2, 0x1ff4}, {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b},
{0x2d00, 0x2d25}, {0xa72f, 0xa731}, {0xa771, 0xa778}, {0xa793, 0xa795},
{0xab30, 0xab5a}, {0xab60, 0xab65}, {0xab70, 0xabbf}, {0xfb00, 0xfb06},
{0xfb13, 0xfb17}, {0xff41, 0xff5a}
#if TCL_UTF_MAX > 4
,{0x10428, 0x1044f}, {0x104d8, 0x104fb}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df},
{0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, {0x1d482, 0x1d49b},
{0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503},
{0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3},
{0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5},
{0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b},
{0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d78f},
{0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943}
#endif
};
#define NUM_LOWER_RANGE (sizeof(lowerRangeTable)/sizeof(crange))
static const chr lowerCharTable[] = {
0xb5, 0x101, 0x103, 0x105, 0x107, 0x109, 0x10b, 0x10d, 0x10f,
|
| ︙ | ︙ | |||
2587 2588 2589 2590 2591 2592 2593 |
0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749, 0xa74b, 0xa74d, 0xa74f,
0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b, 0xa75d, 0xa75f, 0xa761,
0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c,
0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797,
0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9,
0xa7b5, 0xa7b7, 0xa7fa
#if TCL_UTF_MAX > 4
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 |
0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749, 0xa74b, 0xa74d, 0xa74f,
0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b, 0xa75d, 0xa75f, 0xa761,
0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c,
0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797,
0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9,
0xa7b5, 0xa7b7, 0xa7fa
#if TCL_UTF_MAX > 4
,0x1d4bb, 0x1d7cb
#endif
};
#define NUM_LOWER_CHAR (sizeof(lowerCharTable)/sizeof(chr))
/*
* Unicode: uppercase characters.
|
| ︙ | ︙ | |||
3622 3623 3624 3625 3626 3627 3628 |
{0x13a0, 0x13f5}, {0x1f08, 0x1f0f}, {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f},
{0x1f38, 0x1f3f}, {0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb},
{0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb},
{0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d},
{0x2130, 0x2133}, {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70},
{0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae}, {0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
#if TCL_UTF_MAX > 4
| | | | | | | < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 |
{0x13a0, 0x13f5}, {0x1f08, 0x1f0f}, {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f},
{0x1f38, 0x1f3f}, {0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb},
{0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb},
{0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d},
{0x2130, 0x2133}, {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70},
{0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae}, {0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
#if TCL_UTF_MAX > 4
,{0x10400, 0x10427}, {0x104b0, 0x104d3}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf},
{0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac},
{0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
{0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550},
{0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621},
{0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa},
{0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}, {0x1e900, 0x1e921}
#endif
};
#define NUM_UPPER_RANGE (sizeof(upperRangeTable)/sizeof(crange))
static const chr upperCharTable[] = {
0x100, 0x102, 0x104, 0x106, 0x108, 0x10a, 0x10c, 0x10e, 0x110,
|
| ︙ | ︙ | |||
3852 3853 3854 3855 3856 3857 3858 |
0xa732, 0xa734, 0xa736, 0xa738, 0xa73a, 0xa73c, 0xa73e, 0xa740, 0xa742,
0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750, 0xa752, 0xa754,
0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766,
0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780,
0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798,
0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6
#if TCL_UTF_MAX > 4
| | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 |
0xa732, 0xa734, 0xa736, 0xa738, 0xa73a, 0xa73c, 0xa73e, 0xa740, 0xa742,
0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750, 0xa752, 0xa754,
0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766,
0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780,
0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798,
0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6
#if TCL_UTF_MAX > 4
,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538,
0x1d539, 0x1d546, 0x1d7ca
#endif
};
#define NUM_UPPER_CHAR (sizeof(upperCharTable)/sizeof(chr))
/*
* Unicode: unicode print characters excluding space.
|
| ︙ | ︙ | |||
4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 |
{0xa7b0, 0xa7b7}, {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
{0xa880, 0xa8c5}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fd}, {0xa900, 0xa953},
{0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe},
{0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaac2},
{0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
{0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab65}, {0xab70, 0xabed},
{0xabf0, 0xabf9}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
{0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
{0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f},
{0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19},
{0xfe20, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74},
{0xfe76, 0xfefc}, {0xff01, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf},
{0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6}, {0xffe8, 0xffee}
#if TCL_UTF_MAX > 4
| > > > > | | < | < | | < | < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < | < < < < < < < < < < < < < < | < < < < < | < < < | | | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < | < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 |
{0xa7b0, 0xa7b7}, {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
{0xa880, 0xa8c5}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fd}, {0xa900, 0xa953},
{0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe},
{0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaac2},
{0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
{0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab65}, {0xab70, 0xabed},
{0xabf0, 0xabf9}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
{0xdc00, 0xdc3e}, {0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe},
{0xdd00, 0xdd3e}, {0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe},
{0xde00, 0xde3e}, {0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe},
{0xdf00, 0xdf3e}, {0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe},
{0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
{0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f},
{0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19},
{0xfe20, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74},
{0xfe76, 0xfefc}, {0xff01, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf},
{0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6}, {0xffe8, 0xffee}
#if TCL_UTF_MAX > 4
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133},
{0x10137, 0x1018e}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
{0x102a0, 0x102d0}, {0x102e0, 0x102fb}, {0x10300, 0x10323}, {0x1032d, 0x1034a},
{0x10350, 0x1037a}, {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5},
{0x10400, 0x1049d}, {0x104a0, 0x104a9}, {0x104b0, 0x104d3}, {0x104d8, 0x104fb},
{0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755},
{0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
{0x10857, 0x1089e}, {0x108a7, 0x108af}, {0x108e0, 0x108f2}, {0x108fb, 0x1091b},
{0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x109bc, 0x109cf}, {0x109d2, 0x10a03},
{0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a38, 0x10a3a},
{0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
{0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72},
{0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48},
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10cff}, {0x10e60, 0x10e7e},
{0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1},
{0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11143},
{0x11150, 0x11176}, {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4},
{0x11200, 0x11211}, {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
{0x1128f, 0x1129d}, {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9},
{0x11300, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330},
{0x11335, 0x11339}, {0x1133c, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363},
{0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7},
{0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644},
{0x11650, 0x11659}, {0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9},
{0x11700, 0x11719}, {0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x118a0, 0x118f2},
{0x11a00, 0x11a47}, {0x11a50, 0x11a83}, {0x11a86, 0x11a9c}, {0x11a9e, 0x11aa2},
{0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45},
{0x11c50, 0x11c6c}, {0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6},
{0x11d00, 0x11d06}, {0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59},
{0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474}, {0x12480, 0x12543},
{0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
{0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, {0x16b00, 0x16b45},
{0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f},
{0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x17000, 0x187ec},
{0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb}, {0x1bc00, 0x1bc6a},
{0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, {0x1bc9c, 0x1bc9f},
{0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172}, {0x1d17b, 0x1d1e8},
{0x1d200, 0x1d245}, {0x1d300, 0x1d356}, {0x1d360, 0x1d371}, {0x1d400, 0x1d454},
{0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3},
{0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c},
{0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550},
{0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, {0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f},
{0x1daa1, 0x1daaf}, {0x1e000, 0x1e006}, {0x1e008, 0x1e018}, {0x1e01b, 0x1e021},
{0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4}, {0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a},
{0x1e950, 0x1e959}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32},
{0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72},
{0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b},
{0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b},
{0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf},
{0x1f0d1, 0x1f0f5}, {0x1f100, 0x1f10c}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b},
{0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23b}, {0x1f240, 0x1f248},
{0x1f260, 0x1f265}, {0x1f300, 0x1f6d4}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f8},
{0x1f700, 0x1f773}, {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847},
{0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b},
{0x1f910, 0x1f93e}, {0x1f940, 0x1f94c}, {0x1f950, 0x1f96b}, {0x1f980, 0x1f997},
{0x1f9d0, 0x1f9e6}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
{0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
#endif
};
#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))
static const chr graphCharTable[] = {
0x38c, 0x589, 0x58a, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8,
0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36,
0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3,
0xad0, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57,
0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f,
0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde,
0xcf1, 0xcf2, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82,
0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab,
0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59,
0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e,
0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd
#if TCL_UTF_MAX > 4
,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4,
0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333,
0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x118ff, 0x11d08, 0x11d09,
0x11d3a, 0x11d3c, 0x11d3d, 0x16a6e, 0x16a6f, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f,
0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f,
0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49,
0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f,
0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f9c0
#endif
};
#define NUM_GRAPH_CHAR (sizeof(graphCharTable)/sizeof(chr))
/*
* End of auto-generated Unicode character ranges declarations.
|
| ︙ | ︙ |
Changes to generic/tclBasic.c.
| ︙ | ︙ | |||
281 282 283 284 285 286 287 288 289 290 291 292 293 294 |
{"pwd", Tcl_PwdObjCmd, NULL, NULL, 0},
{"read", Tcl_ReadObjCmd, NULL, NULL, CMD_IS_SAFE},
{"seek", Tcl_SeekObjCmd, NULL, NULL, CMD_IS_SAFE},
{"socket", Tcl_SocketObjCmd, NULL, NULL, 0},
{"source", Tcl_SourceObjCmd, NULL, TclNRSourceObjCmd, 0},
{"tell", Tcl_TellObjCmd, NULL, NULL, CMD_IS_SAFE},
{"time", Tcl_TimeObjCmd, NULL, NULL, CMD_IS_SAFE},
{"unload", Tcl_UnloadObjCmd, NULL, NULL, 0},
{"update", Tcl_UpdateObjCmd, NULL, NULL, CMD_IS_SAFE},
{"vwait", Tcl_VwaitObjCmd, NULL, NULL, CMD_IS_SAFE},
{NULL, NULL, NULL, NULL, 0}
};
/*
| > | 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 |
{"pwd", Tcl_PwdObjCmd, NULL, NULL, 0},
{"read", Tcl_ReadObjCmd, NULL, NULL, CMD_IS_SAFE},
{"seek", Tcl_SeekObjCmd, NULL, NULL, CMD_IS_SAFE},
{"socket", Tcl_SocketObjCmd, NULL, NULL, 0},
{"source", Tcl_SourceObjCmd, NULL, TclNRSourceObjCmd, 0},
{"tell", Tcl_TellObjCmd, NULL, NULL, CMD_IS_SAFE},
{"time", Tcl_TimeObjCmd, NULL, NULL, CMD_IS_SAFE},
{"timerate", Tcl_TimeRateObjCmd, NULL, NULL, CMD_IS_SAFE},
{"unload", Tcl_UnloadObjCmd, NULL, NULL, 0},
{"update", Tcl_UpdateObjCmd, NULL, NULL, CMD_IS_SAFE},
{"vwait", Tcl_VwaitObjCmd, NULL, NULL, CMD_IS_SAFE},
{NULL, NULL, NULL, NULL, 0}
};
/*
|
| ︙ | ︙ |
Changes to generic/tclClock.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | /* * tclClock.c -- * * Contains the time and date related commands. This code is derived from * the time and date facilities of TclX, by Mark Diekhans and Karl * Lehenbauer. * * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans. * Copyright (c) 1995 Sun Microsystems, Inc. * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * Windows has mktime. The configurators do not check. */ #ifdef _WIN32 #define HAVE_MKTIME 1 #endif | > > > > < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < | < < | < | < < < > < < < < < < < < < < < < < < < < < < < < < | > | | | > | | < < < > > > > > > > > > > | | > > > > > > > > > | > > > > > > | > > > > > | | | | | | | < | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 |
/*
* tclClock.c --
*
* Contains the time and date related commands. This code is derived from
* the time and date facilities of TclX, by Mark Diekhans and Karl
* Lehenbauer.
*
* Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
* Copyright (c) 1995 Sun Microsystems, Inc.
* Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
* Copyright (c) 2015 by Sergey G. Brester aka sebres. All rights reserved.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
#include "tclStrIdxTree.h"
#include "tclDate.h"
#include "tclCompile.h"
/*
* Windows has mktime. The configurators do not check.
*/
#ifdef _WIN32
#define HAVE_MKTIME 1
#endif
/*
* Table of the days in each month, leap and common years
*/
static const int hath[2][12] = {
{31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31},
{31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}
};
static const int daysInPriorMonths[2][13] = {
{0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365},
{0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366}
};
/*
* Enumeration of the string literals used in [clock]
*/
CLOCK_LITERAL_ARRAY(Literals);
/* Msgcat literals for exact match (mcKey) */
CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLiterals, "");
/* Msgcat index literals prefixed with _IDX_, used for quick dictionary search */
CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLitIdxs, "_IDX_");
static const char *const eras[] = { "CE", "BCE", NULL };
/*
* Thread specific data block holding a 'struct tm' for the 'gmtime' and
* 'localtime' library calls.
*/
static Tcl_ThreadDataKey tmKey;
/*
* Mutex protecting 'gmtime', 'localtime' and 'mktime' calls and the statics
* in the date parsing code.
*/
TCL_DECLARE_MUTEX(clockMutex)
/*
* Function prototypes for local procedures in this file:
*/
static int ConvertUTCToLocalUsingTable(Tcl_Interp *,
TclDateFields *, int, Tcl_Obj *const[],
Tcl_WideInt rangesVal[2]);
static int ConvertUTCToLocalUsingC(Tcl_Interp *,
TclDateFields *, int);
static int ConvertLocalToUTC(ClientData clientData, Tcl_Interp *,
TclDateFields *, Tcl_Obj *timezoneObj, int);
static int ConvertLocalToUTCUsingTable(Tcl_Interp *,
TclDateFields *, int, Tcl_Obj *const[],
Tcl_WideInt rangesVal[2]);
static int ConvertLocalToUTCUsingC(Tcl_Interp *,
TclDateFields *, int);
static int ClockConfigureObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static void GetYearWeekDay(TclDateFields *, int);
static void GetGregorianEraYearDay(TclDateFields *, int);
static void GetMonthDay(TclDateFields *);
static int WeekdayOnOrBefore(int, int);
static int ClockClicksObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int ClockConvertlocaltoutcObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int ClockGetDateFields(ClientData clientData,
Tcl_Interp *interp, TclDateFields *fields,
Tcl_Obj *timezoneObj, int changeover);
static int ClockGetdatefieldsObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int ClockGetjuliandayfromerayearmonthdayObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int ClockGetjuliandayfromerayearweekdayObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int ClockGetenvObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int ClockMicrosecondsObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int ClockMillisecondsObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int ClockSecondsObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int ClockFormatObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int ClockScanObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int ClockScanCommit(
ClientData clientData, register DateInfo *info,
register ClockFmtScnCmdArgs *opts);
static int ClockFreeScan(
register DateInfo *info,
Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts);
static int ClockCalcRelTime(
register DateInfo *info, ClockFmtScnCmdArgs *opts);
static int ClockAddObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static struct tm * ThreadSafeLocalTime(const time_t *);
static unsigned long TzsetGetEpoch(void);
static void TzsetIfNecessary(void);
static void ClockDeleteCmdProc(ClientData);
/*
* Structure containing description of "native" clock commands to create.
*/
struct ClockCommand {
const char *name; /* The tail of the command name. The full name
* is "::tcl::clock::<name>". When NULL marks
* the end of the table. */
Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This
* will always have the ClockClientData sent
* to it, but may well ignore this data. */
CompileProc *compileProc; /* The compiler for the command. */
ClientData clientData; /* Any clientData to give the command (if NULL
* a reference to ClockClientData will be sent) */
};
static const struct ClockCommand clockCommands[] = {
{"add", ClockAddObjCmd, TclCompileBasicMin1ArgCmd, NULL},
{"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL},
{"format", ClockFormatObjCmd, TclCompileBasicMin1ArgCmd, NULL},
{"getenv", ClockGetenvObjCmd, TclCompileBasicMin1ArgCmd, NULL},
{"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(1)},
{"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2)},
{"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL},
{"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(3)},
{"configure", ClockConfigureObjCmd, NULL, NULL},
{"Oldscan", TclClockOldscanObjCmd, NULL, NULL},
{"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, NULL},
{"GetDateFields", ClockGetdatefieldsObjCmd, NULL, NULL},
{"GetJulianDayFromEraYearMonthDay",
ClockGetjuliandayfromerayearmonthdayObjCmd, NULL, NULL},
{"GetJulianDayFromEraYearWeekDay",
ClockGetjuliandayfromerayearweekdayObjCmd, NULL, NULL},
{NULL, NULL, NULL, NULL}
};
/*
*----------------------------------------------------------------------
*
* TclClockInit --
*
|
| ︙ | ︙ | |||
242 243 244 245 246 247 248 249 250 251 |
TclClockInit(
Tcl_Interp *interp) /* Tcl interpreter */
{
const struct ClockCommand *clockCmdPtr;
char cmdName[50]; /* Buffer large enough to hold the string
*::tcl::clock::GetJulianDayFromEraYearMonthDay
* plus a terminating NUL. */
ClockClientData *data;
int i;
| > < < < < < < < < < < < < < | > > > > > > > > > > > > > > > | > > > > > | > > > > < > > > > | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 |
TclClockInit(
Tcl_Interp *interp) /* Tcl interpreter */
{
const struct ClockCommand *clockCmdPtr;
char cmdName[50]; /* Buffer large enough to hold the string
*::tcl::clock::GetJulianDayFromEraYearMonthDay
* plus a terminating NUL. */
Command *cmdPtr;
ClockClientData *data;
int i;
/*
* Safe interps get [::clock] as alias to a master, so do not need their
* own copies of the support routines.
*/
if (Tcl_IsSafe(interp)) {
return;
}
/*
* Create the client data, which is a refcounted literal pool.
*/
data = ckalloc(sizeof(ClockClientData));
data->refCount = 0;
data->literals = ckalloc(LIT__END * sizeof(Tcl_Obj*));
for (i = 0; i < LIT__END; ++i) {
Tcl_InitObjRef(data->literals[i], Tcl_NewStringObj(Literals[i], -1));
}
data->mcLiterals = NULL;
data->mcLitIdxs = NULL;
data->LastTZEpoch = 0;
data->currentYearCentury = ClockDefaultYearCentury;
data->yearOfCenturySwitch = ClockDefaultCenturySwitch;
data->SystemTimeZone = NULL;
data->SystemSetupTZData = NULL;
data->GMTSetupTimeZone = NULL;
data->GMTSetupTZData = NULL;
data->AnySetupTimeZone = NULL;
data->AnySetupTZData = NULL;
data->LastUnnormSetupTimeZone = NULL;
data->LastSetupTimeZone = NULL;
data->LastSetupTZData = NULL;
data->CurrentLocale = NULL;
data->CurrentLocaleDict = NULL;
data->LastUnnormUsedLocale = NULL;
data->LastUsedLocale = NULL;
data->LastUsedLocaleDict = NULL;
data->lastBase.timezoneObj = NULL;
data->UTC2Local.timezoneObj = NULL;
data->UTC2Local.tzName = NULL;
data->Local2UTC.timezoneObj = NULL;
/*
* Install the commands.
*/
#define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */
memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN);
for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) {
ClientData clientData;
strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name);
if (!(clientData = clockCmdPtr->clientData)) {
clientData = data;
data->refCount++;
}
cmdPtr = (Command *)Tcl_CreateObjCommand(interp, cmdName,
clockCmdPtr->objCmdProc, clientData,
clockCmdPtr->clientData ? NULL : ClockDeleteCmdProc);
cmdPtr->compileProc = clockCmdPtr->compileProc ?
clockCmdPtr->compileProc : TclCompileBasicMin0ArgCmd;
}
}
/*
*----------------------------------------------------------------------
*
* ClockConfigureClear --
*
* Clean up cached resp. run-time storages used in clock commands.
*
* Shared usage for clean-up (ClockDeleteCmdProc) and "configure -clear".
*
* Results:
* None.
*
*----------------------------------------------------------------------
*/
static void
ClockConfigureClear(
ClockClientData *data)
{
ClockFrmScnClearCaches();
data->LastTZEpoch = 0;
Tcl_UnsetObjRef(data->SystemTimeZone);
Tcl_UnsetObjRef(data->SystemSetupTZData);
Tcl_UnsetObjRef(data->GMTSetupTimeZone);
Tcl_UnsetObjRef(data->GMTSetupTZData);
Tcl_UnsetObjRef(data->AnySetupTimeZone);
Tcl_UnsetObjRef(data->AnySetupTZData);
Tcl_UnsetObjRef(data->LastUnnormSetupTimeZone);
Tcl_UnsetObjRef(data->LastSetupTimeZone);
Tcl_UnsetObjRef(data->LastSetupTZData);
Tcl_UnsetObjRef(data->CurrentLocale);
Tcl_UnsetObjRef(data->CurrentLocaleDict);
Tcl_UnsetObjRef(data->LastUnnormUsedLocale);
Tcl_UnsetObjRef(data->LastUsedLocale);
Tcl_UnsetObjRef(data->LastUsedLocaleDict);
Tcl_UnsetObjRef(data->lastBase.timezoneObj);
Tcl_UnsetObjRef(data->UTC2Local.timezoneObj);
Tcl_UnsetObjRef(data->UTC2Local.tzName);
Tcl_UnsetObjRef(data->Local2UTC.timezoneObj);
}
/*
*----------------------------------------------------------------------
*
* ClockDeleteCmdProc --
*
* Remove a reference to the clock client data, and clean up memory
* when it's all gone.
*
* Results:
* None.
*
*----------------------------------------------------------------------
*/
static void
ClockDeleteCmdProc(
ClientData clientData) /* Opaque pointer to the client data */
{
ClockClientData *data = clientData;
int i;
if (data->refCount-- <= 1) {
for (i = 0; i < LIT__END; ++i) {
Tcl_DecrRefCount(data->literals[i]);
}
if (data->mcLiterals != NULL) {
for (i = 0; i < MCLIT__END; ++i) {
Tcl_DecrRefCount(data->mcLiterals[i]);
}
data->mcLiterals = NULL;
}
if (data->mcLitIdxs != NULL) {
for (i = 0; i < MCLIT__END; ++i) {
Tcl_DecrRefCount(data->mcLitIdxs[i]);
}
data->mcLitIdxs = NULL;
}
ClockConfigureClear(data);
ckfree(data->literals);
ckfree(data);
}
}
/*
*----------------------------------------------------------------------
*
* NormTimezoneObj --
*
* Normalizes the timezone object (used for caching puposes).
*
* If already cached time zone could be found, returns this
* object (last setup or last used, system (current) or gmt).
*
* Results:
* Normalized tcl object pointer.
*
*----------------------------------------------------------------------
*/
static inline Tcl_Obj *
NormTimezoneObj(
ClockClientData *dataPtr, /* Client data containing literal pool */
Tcl_Obj *timezoneObj)
{
const char *tz;
if ( timezoneObj == dataPtr->LastUnnormSetupTimeZone
&& dataPtr->LastSetupTimeZone != NULL
) {
return dataPtr->LastSetupTimeZone;
}
if ( timezoneObj == dataPtr->LastSetupTimeZone
|| timezoneObj == dataPtr->literals[LIT_GMT]
|| timezoneObj == dataPtr->SystemTimeZone
|| timezoneObj == dataPtr->AnySetupTimeZone
) {
return timezoneObj;
}
tz = TclGetString(timezoneObj);
if (dataPtr->AnySetupTimeZone != NULL &&
(timezoneObj == dataPtr->AnySetupTimeZone
|| strcmp(tz, TclGetString(dataPtr->AnySetupTimeZone)) == 0
)
) {
timezoneObj = dataPtr->AnySetupTimeZone;
}
else
if (dataPtr->SystemTimeZone != NULL &&
(timezoneObj == dataPtr->SystemTimeZone
|| strcmp(tz, TclGetString(dataPtr->SystemTimeZone)) == 0
)
) {
timezoneObj = dataPtr->SystemTimeZone;
}
else
if (
strcmp(tz, Literals[LIT_GMT]) == 0
) {
timezoneObj = dataPtr->literals[LIT_GMT];
}
return timezoneObj;
}
/*
*----------------------------------------------------------------------
*
* ClockGetSystemLocale --
*
* Returns system locale.
*
* Executes ::tcl::clock::GetSystemLocale in given interpreter.
*
* Results:
* Returns system locale tcl object.
*
*----------------------------------------------------------------------
*/
static inline Tcl_Obj *
ClockGetSystemLocale(
ClockClientData *dataPtr, /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp) /* Tcl interpreter */
{
if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETSYSTEMLOCALE], 0) != TCL_OK) {
return NULL;
}
return Tcl_GetObjResult(interp);
}
/*
*----------------------------------------------------------------------
*
* ClockGetCurrentLocale --
*
* Returns current locale.
*
* Executes ::tcl::clock::mclocale in given interpreter.
*
* Results:
* Returns current locale tcl object.
*
*----------------------------------------------------------------------
*/
static inline Tcl_Obj *
ClockGetCurrentLocale(
ClockClientData *dataPtr, /* Client data containing literal pool */
Tcl_Interp *interp) /* Tcl interpreter */
{
if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETCURRENTLOCALE], 0) != TCL_OK) {
return NULL;
}
Tcl_SetObjRef(dataPtr->CurrentLocale, Tcl_GetObjResult(interp));
Tcl_UnsetObjRef(dataPtr->CurrentLocaleDict);
return dataPtr->CurrentLocale;
}
/*
*----------------------------------------------------------------------
*
* NormLocaleObj --
*
* Normalizes the locale object (used for caching puposes).
*
* If already cached locale could be found, returns this
* object (current, system (OS) or last used locales).
*
* Results:
* Normalized tcl object pointer.
*
*----------------------------------------------------------------------
*/
static Tcl_Obj *
NormLocaleObj(
ClockClientData *dataPtr, /* Client data containing literal pool */
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Obj *localeObj,
Tcl_Obj **mcDictObj)
{
const char *loc;
if ( localeObj == NULL || localeObj == dataPtr->CurrentLocale
|| localeObj == dataPtr->literals[LIT_C]
|| localeObj == dataPtr->literals[LIT_CURRENT]
) {
if (dataPtr->CurrentLocale == NULL) {
ClockGetCurrentLocale(dataPtr, interp);
}
*mcDictObj = dataPtr->CurrentLocaleDict;
return dataPtr->CurrentLocale;
}
if ( localeObj == dataPtr->LastUsedLocale
|| localeObj == dataPtr->LastUnnormUsedLocale
) {
*mcDictObj = dataPtr->LastUsedLocaleDict;
return dataPtr->LastUsedLocale;
}
loc = TclGetString(localeObj);
if ( dataPtr->CurrentLocale != NULL
&& ( localeObj == dataPtr->CurrentLocale
|| (localeObj->length == dataPtr->CurrentLocale->length
&& strcmp(loc, TclGetString(dataPtr->CurrentLocale)) == 0
)
)
) {
*mcDictObj = dataPtr->CurrentLocaleDict;
localeObj = dataPtr->CurrentLocale;
}
else
if ( dataPtr->LastUsedLocale != NULL
&& ( localeObj == dataPtr->LastUsedLocale
|| (localeObj->length == dataPtr->LastUsedLocale->length
&& strcmp(loc, TclGetString(dataPtr->LastUsedLocale)) == 0
)
)
) {
*mcDictObj = dataPtr->LastUsedLocaleDict;
Tcl_SetObjRef(dataPtr->LastUnnormUsedLocale, localeObj);
localeObj = dataPtr->LastUsedLocale;
}
else
if (
(localeObj->length == 1 /* C */
&& strncasecmp(loc, Literals[LIT_C], localeObj->length) == 0)
|| (localeObj->length == 7 /* current */
&& strncasecmp(loc, Literals[LIT_CURRENT], localeObj->length) == 0)
) {
if (dataPtr->CurrentLocale == NULL) {
ClockGetCurrentLocale(dataPtr, interp);
}
*mcDictObj = dataPtr->CurrentLocaleDict;
localeObj = dataPtr->CurrentLocale;
}
else
if (
(localeObj->length == 6 /* system */
&& strncasecmp(loc, Literals[LIT_SYSTEM], localeObj->length) == 0)
) {
Tcl_SetObjRef(dataPtr->LastUnnormUsedLocale, localeObj);
localeObj = ClockGetSystemLocale(dataPtr, interp);
Tcl_SetObjRef(dataPtr->LastUsedLocale, localeObj);
*mcDictObj = NULL;
}
else
{
*mcDictObj = NULL;
}
return localeObj;
}
/*
*----------------------------------------------------------------------
*
* ClockMCDict --
*
* Retrieves a localized storage dictionary object for the given
* locale object.
*
* This corresponds with call `::tcl::clock::mcget locale`.
* Cached representation stored in options (for further access).
*
* Results:
* Tcl-object contains smart reference to msgcat dictionary.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE Tcl_Obj *
ClockMCDict(ClockFmtScnCmdArgs *opts)
{
ClockClientData *dataPtr = opts->clientData;
/* if dict not yet retrieved */
if (opts->mcDictObj == NULL) {
/* if locale was not yet used */
if ( !(opts->flags & CLF_LOCALE_USED) ) {
opts->localeObj = NormLocaleObj(opts->clientData, opts->interp,
opts->localeObj, &opts->mcDictObj);
if (opts->localeObj == NULL) {
Tcl_SetObjResult(opts->interp,
Tcl_NewStringObj("locale not specified and no default locale set", -1));
Tcl_SetErrorCode(opts->interp, "CLOCK", "badOption", NULL);
return NULL;
}
opts->flags |= CLF_LOCALE_USED;
/* check locale literals already available (on demand creation) */
if (dataPtr->mcLiterals == NULL) {
int i;
dataPtr->mcLiterals = ckalloc(MCLIT__END * sizeof(Tcl_Obj*));
for (i = 0; i < MCLIT__END; ++i) {
Tcl_InitObjRef(dataPtr->mcLiterals[i],
Tcl_NewStringObj(MsgCtLiterals[i], -1));
}
}
}
if (opts->mcDictObj == NULL) {
Tcl_Obj *callargs[2];
/* get msgcat dictionary - ::tcl::clock::mcget locale */
callargs[0] = dataPtr->literals[LIT_MCGET];
callargs[1] = opts->localeObj;
if (Tcl_EvalObjv(opts->interp, 2, callargs, 0) != TCL_OK) {
return NULL;
}
opts->mcDictObj = Tcl_GetObjResult(opts->interp);
/* be sure that object reference not increases (dict changeable) */
if (opts->mcDictObj->refCount > 0) {
/* smart reference (shared dict as object with no ref-counter) */
opts->mcDictObj = Tcl_DictObjSmartRef(opts->interp, opts->mcDictObj);
}
if ( opts->localeObj == dataPtr->CurrentLocale ) {
Tcl_SetObjRef(dataPtr->CurrentLocaleDict, opts->mcDictObj);
} else if ( opts->localeObj == dataPtr->LastUsedLocale ) {
Tcl_SetObjRef(dataPtr->LastUsedLocaleDict, opts->mcDictObj);
} else {
Tcl_SetObjRef(dataPtr->LastUsedLocale, opts->localeObj);
Tcl_UnsetObjRef(dataPtr->LastUnnormUsedLocale);
Tcl_SetObjRef(dataPtr->LastUsedLocaleDict, opts->mcDictObj);
}
Tcl_ResetResult(opts->interp);
}
}
return opts->mcDictObj;
}
/*
*----------------------------------------------------------------------
*
* ClockMCGet --
*
* Retrieves a msgcat value for the given literal integer mcKey
* from localized storage (corresponding given locale object)
* by mcLiterals[mcKey] (e. g. MONTHS_FULL).
*
* Results:
* Tcl-object contains localized value.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE Tcl_Obj *
ClockMCGet(
ClockFmtScnCmdArgs *opts,
int mcKey)
{
ClockClientData *dataPtr = opts->clientData;
Tcl_Obj *valObj = NULL;
if (opts->mcDictObj == NULL) {
ClockMCDict(opts);
if (opts->mcDictObj == NULL)
return NULL;
}
Tcl_DictObjGet(opts->interp, opts->mcDictObj,
dataPtr->mcLiterals[mcKey], &valObj);
return valObj; /* or NULL in obscure case if Tcl_DictObjGet failed */
}
/*
*----------------------------------------------------------------------
*
* ClockMCGetIdx --
*
* Retrieves an indexed msgcat value for the given literal integer mcKey
* from localized storage (corresponding given locale object)
* by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL).
*
* Results:
* Tcl-object contains localized indexed value.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE Tcl_Obj *
ClockMCGetIdx(
ClockFmtScnCmdArgs *opts,
int mcKey)
{
ClockClientData *dataPtr = opts->clientData;
Tcl_Obj *valObj = NULL;
if (opts->mcDictObj == NULL) {
ClockMCDict(opts);
if (opts->mcDictObj == NULL)
return NULL;
}
/* try to get indices object */
if (dataPtr->mcLitIdxs == NULL) {
return NULL;
}
if (Tcl_DictObjGet(NULL, opts->mcDictObj,
dataPtr->mcLitIdxs[mcKey], &valObj) != TCL_OK
) {
return NULL;
}
return valObj;
}
/*
*----------------------------------------------------------------------
*
* ClockMCSetIdx --
*
* Sets an indexed msgcat value for the given literal integer mcKey
* in localized storage (corresponding given locale object)
* by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL).
*
* Results:
* Returns a standard Tcl result.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE int
ClockMCSetIdx(
ClockFmtScnCmdArgs *opts,
int mcKey, Tcl_Obj *valObj)
{
ClockClientData *dataPtr = opts->clientData;
if (opts->mcDictObj == NULL) {
ClockMCDict(opts);
if (opts->mcDictObj == NULL)
return TCL_ERROR;
}
/* if literal storage for indices not yet created */
if (dataPtr->mcLitIdxs == NULL) {
int i;
dataPtr->mcLitIdxs = ckalloc(MCLIT__END * sizeof(Tcl_Obj*));
for (i = 0; i < MCLIT__END; ++i) {
Tcl_InitObjRef(dataPtr->mcLitIdxs[i],
Tcl_NewStringObj(MsgCtLitIdxs[i], -1));
}
}
return Tcl_DictObjPut(opts->interp, opts->mcDictObj,
dataPtr->mcLitIdxs[mcKey], valObj);
}
/*
*----------------------------------------------------------------------
*
* ClockConfigureObjCmd --
*
* This function is invoked to process the Tcl "clock configure" command.
*
* Usage:
* ::tcl::clock::configure ?-option ?value??
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
ClockConfigureObjCmd(
ClientData clientData, /* Client data containing literal pool */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const objv[]) /* Parameter vector */
{
ClockClientData *dataPtr = clientData;
static const char *const options[] = {
"-system-tz", "-setup-tz", "-default-locale",
"-clear",
"-year-century", "-century-switch",
NULL
};
enum optionInd {
CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_CURRENT_LOCALE,
CLOCK_CLEAR_CACHE,
CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH,
CLOCK_SETUP_GMT, CLOCK_SETUP_NOP
};
int optionIndex; /* Index of an option. */
int i;
for (i = 1; i < objc; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i++], options,
"option", 0, &optionIndex) != TCL_OK) {
Tcl_SetErrorCode(interp, "CLOCK", "badOption",
Tcl_GetString(objv[i-1]), NULL);
return TCL_ERROR;
}
switch (optionIndex) {
case CLOCK_SYSTEM_TZ:
if (1) {
/* validate current tz-epoch */
unsigned long lastTZEpoch = TzsetGetEpoch();
if (i < objc) {
if (dataPtr->SystemTimeZone != objv[i]) {
Tcl_SetObjRef(dataPtr->SystemTimeZone, objv[i]);
Tcl_UnsetObjRef(dataPtr->SystemSetupTZData);
}
dataPtr->LastTZEpoch = lastTZEpoch;
}
if (i+1 >= objc && dataPtr->SystemTimeZone != NULL
&& dataPtr->LastTZEpoch == lastTZEpoch) {
Tcl_SetObjResult(interp, dataPtr->SystemTimeZone);
}
}
break;
case CLOCK_SETUP_TZ:
if (i < objc) {
/* differentiate GMT and system zones, because used often */
Tcl_Obj *timezoneObj = NormTimezoneObj(dataPtr, objv[i]);
Tcl_SetObjRef(dataPtr->LastUnnormSetupTimeZone, objv[i]);
if (dataPtr->LastSetupTimeZone != timezoneObj) {
Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj);
Tcl_UnsetObjRef(dataPtr->LastSetupTZData);
}
if (timezoneObj == dataPtr->literals[LIT_GMT]) {
optionIndex = CLOCK_SETUP_GMT;
} else if (timezoneObj == dataPtr->SystemTimeZone) {
optionIndex = CLOCK_SETUP_NOP;
}
switch (optionIndex) {
case CLOCK_SETUP_GMT:
if (i < objc) {
if (dataPtr->GMTSetupTimeZone != timezoneObj) {
Tcl_SetObjRef(dataPtr->GMTSetupTimeZone, timezoneObj);
Tcl_UnsetObjRef(dataPtr->GMTSetupTZData);
}
}
break;
case CLOCK_SETUP_TZ:
if (i < objc) {
if (dataPtr->AnySetupTimeZone != timezoneObj) {
Tcl_SetObjRef(dataPtr->AnySetupTimeZone, timezoneObj);
Tcl_UnsetObjRef(dataPtr->AnySetupTZData);
}
}
break;
}
}
if (i+1 >= objc && dataPtr->LastSetupTimeZone != NULL) {
Tcl_SetObjResult(interp, dataPtr->LastSetupTimeZone);
}
break;
case CLOCK_CURRENT_LOCALE:
if (i < objc) {
if (dataPtr->CurrentLocale != objv[i]) {
Tcl_SetObjRef(dataPtr->CurrentLocale, objv[i]);
Tcl_UnsetObjRef(dataPtr->CurrentLocaleDict);
}
}
if (i+1 >= objc && dataPtr->CurrentLocale != NULL) {
Tcl_SetObjResult(interp, dataPtr->CurrentLocale);
}
break;
case CLOCK_YEAR_CENTURY:
if (i < objc) {
int year;
if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) {
return TCL_ERROR;
}
dataPtr->currentYearCentury = year;
if (i+1 >= objc) {
Tcl_SetObjResult(interp, objv[i]);
}
continue;
}
if (i+1 >= objc) {
Tcl_SetObjResult(interp,
Tcl_NewIntObj(dataPtr->currentYearCentury));
}
break;
case CLOCK_CENTURY_SWITCH:
if (i < objc) {
int year;
if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) {
return TCL_ERROR;
}
dataPtr->yearOfCenturySwitch = year;
Tcl_SetObjResult(interp, objv[i]);
continue;
}
if (i+1 >= objc) {
Tcl_SetObjResult(interp,
Tcl_NewIntObj(dataPtr->yearOfCenturySwitch));
}
break;
case CLOCK_CLEAR_CACHE:
ClockConfigureClear(dataPtr);
break;
}
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ClockGetTZData --
*
* Retrieves tzdata table for given normalized timezone.
*
* Results:
* Returns a tcl object with tzdata.
*
* Side effects:
* The tzdata can be cached in ClockClientData structure.
*
*----------------------------------------------------------------------
*/
static inline Tcl_Obj *
ClockGetTZData(
ClientData clientData, /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Obj *timezoneObj) /* Name of the timezone */
{
ClockClientData *dataPtr = clientData;
Tcl_Obj **literals = dataPtr->literals;
Tcl_Obj *ret, **out = NULL;
/* if cached (if already setup this one) */
if ( dataPtr->LastSetupTZData != NULL
&& ( timezoneObj == dataPtr->LastSetupTimeZone
|| timezoneObj == dataPtr->LastUnnormSetupTimeZone
)
) {
return dataPtr->LastSetupTZData;
}
/* differentiate GMT and system zones, because used often */
/* simple caching, because almost used the tz-data of last timezone
*/
if (timezoneObj == dataPtr->SystemTimeZone) {
if (dataPtr->SystemSetupTZData != NULL) {
return dataPtr->SystemSetupTZData;
}
out = &dataPtr->SystemSetupTZData;
}
else
if (timezoneObj == dataPtr->GMTSetupTimeZone) {
if (dataPtr->GMTSetupTZData != NULL) {
return dataPtr->GMTSetupTZData;
}
out = &dataPtr->GMTSetupTZData;
}
else
if (timezoneObj == dataPtr->AnySetupTimeZone) {
if (dataPtr->AnySetupTZData != NULL) {
return dataPtr->AnySetupTZData;
}
out = &dataPtr->AnySetupTZData;
}
ret = Tcl_ObjGetVar2(interp, literals[LIT_TZDATA],
timezoneObj, TCL_LEAVE_ERR_MSG);
/* cache using corresponding slot and as last used */
if (out != NULL) {
Tcl_SetObjRef(*out, ret);
}
Tcl_SetObjRef(dataPtr->LastSetupTZData, ret);
if (dataPtr->LastSetupTimeZone != timezoneObj) {
Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj);
Tcl_UnsetObjRef(dataPtr->LastUnnormSetupTimeZone);
}
return ret;
}
/*
*----------------------------------------------------------------------
*
* ClockGetSystemTimeZone --
*
* Returns system (current) timezone.
*
* If system zone not yet cached, it executes ::tcl::clock::GetSystemTimeZone
* in given interpreter and caches its result.
*
* Results:
* Returns normalized timezone object.
*
*----------------------------------------------------------------------
*/
static Tcl_Obj *
ClockGetSystemTimeZone(
ClientData clientData, /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp) /* Tcl interpreter */
{
ClockClientData *dataPtr = clientData;
Tcl_Obj **literals;
/* if known (cached and same epoch) - return now */
if (dataPtr->SystemTimeZone != NULL
&& dataPtr->LastTZEpoch == TzsetGetEpoch()) {
return dataPtr->SystemTimeZone;
}
Tcl_UnsetObjRef(dataPtr->SystemTimeZone);
Tcl_UnsetObjRef(dataPtr->SystemSetupTZData);
literals = dataPtr->literals;
if (Tcl_EvalObjv(interp, 1, &literals[LIT_GETSYSTEMTIMEZONE], 0) != TCL_OK) {
return NULL;
}
if (dataPtr->SystemTimeZone == NULL) {
Tcl_SetObjRef(dataPtr->SystemTimeZone, Tcl_GetObjResult(interp));
}
return dataPtr->SystemTimeZone;
}
/*
*----------------------------------------------------------------------
*
* ClockSetupTimeZone --
*
* Sets up the timezone. Loads tzdata, etc.
*
* Results:
* Returns normalized timezone object.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE Tcl_Obj *
ClockSetupTimeZone(
ClientData clientData, /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Obj *timezoneObj)
{
ClockClientData *dataPtr = clientData;
Tcl_Obj **literals = dataPtr->literals;
Tcl_Obj *callargs[2];
/* if cached (if already setup this one) */
if ( dataPtr->LastSetupTimeZone != NULL
&& ( timezoneObj == dataPtr->LastSetupTimeZone
|| timezoneObj == dataPtr->LastUnnormSetupTimeZone
)
) {
return dataPtr->LastSetupTimeZone;
}
/* differentiate GMT and system zones, because used often and already set */
timezoneObj = NormTimezoneObj(dataPtr, timezoneObj);
if ( timezoneObj == dataPtr->GMTSetupTimeZone
|| timezoneObj == dataPtr->SystemTimeZone
|| timezoneObj == dataPtr->AnySetupTimeZone
) {
return timezoneObj;
}
callargs[0] = literals[LIT_SETUPTIMEZONE];
callargs[1] = timezoneObj;
if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) {
return dataPtr->LastSetupTimeZone;
}
return NULL;
}
/*
*----------------------------------------------------------------------
*
* ClockFormatNumericTimeZone --
*
* Formats a time zone as +hhmmss
*
* Parameters:
* z - Time zone in seconds east of Greenwich
*
* Results:
* Returns the time zone object (formatted in a numeric form)
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
ClockFormatNumericTimeZone(int z) {
char sign = '+';
int h, m;
if ( z < 0 ) {
z = -z;
sign = '-';
}
h = z / 3600;
z %= 3600;
m = z / 60;
z %= 60;
if (z != 0) {
return Tcl_ObjPrintf("%c%02d%02d%02d", sign, h, m, z);
}
return Tcl_ObjPrintf("%c%02d%02d", sign, h, m);
}
/*
*----------------------------------------------------------------------
*
* ClockConvertlocaltoutcObjCmd --
*
* Tcl command that converts a UTC time to a local time by whatever means
* is available.
*
* Usage:
* ::tcl::clock::ConvertUTCToLocal dictionary timezone changeover
*
* Parameters:
* dict - Dictionary containing a 'localSeconds' entry.
* timezone - Time zone
* changeover - Julian Day of the adoption of the Gregorian calendar.
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* On success, sets the interpreter result to the given dictionary
|
| ︙ | ︙ | |||
341 342 343 344 345 346 347 348 349 350 351 352 |
Tcl_Obj *secondsObj;
Tcl_Obj *dict;
int changeover;
TclDateFields fields;
int created = 0;
int status;
/*
* Check params and convert time.
*/
if (objc != 4) {
| > | | | | 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 |
Tcl_Obj *secondsObj;
Tcl_Obj *dict;
int changeover;
TclDateFields fields;
int created = 0;
int status;
fields.tzName = NULL;
/*
* Check params and convert time.
*/
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "dict timezone changeover");
return TCL_ERROR;
}
dict = objv[1];
if (Tcl_DictObjGet(interp, dict, literals[LIT_LOCALSECONDS],
&secondsObj)!= TCL_OK) {
return TCL_ERROR;
}
if (secondsObj == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("key \"localseconds\" not "
"found in dictionary", -1));
return TCL_ERROR;
}
if ((TclGetWideIntFromObj(interp, secondsObj,
&fields.localSeconds) != TCL_OK)
|| (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK)
|| ConvertLocalToUTC(clientData, interp, &fields, objv[2], changeover)) {
return TCL_ERROR;
}
/*
* Copy-on-write; set the 'seconds' field in the dictionary and place the
* modified dictionary in the interpreter result.
*/
|
| ︙ | ︙ | |||
396 397 398 399 400 401 402 | * * ClockGetdatefieldsObjCmd -- * * Tcl command that determines the values that [clock format] will use in * formatting a date, and populates a dictionary with them. * * Usage: | | | < | 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 | * * ClockGetdatefieldsObjCmd -- * * Tcl command that determines the values that [clock format] will use in * formatting a date, and populates a dictionary with them. * * Usage: * ::tcl::clock::GetDateFields seconds timezone changeover * * Parameters: * seconds - Time expressed in seconds from the Posix epoch. * timezone - Time zone in which time is to be expressed. * changeover - Julian Day Number at which the current locale adopted * the Gregorian calendar * * Results: * Returns a dictonary populated with the fields: * seconds - Seconds from the Posix epoch * localSeconds - Nominal seconds from the Posix epoch in the |
| ︙ | ︙ | |||
430 431 432 433 434 435 436 437 438 439 440 441 |
{
TclDateFields fields;
Tcl_Obj *dict;
ClockClientData *data = clientData;
Tcl_Obj *const *literals = data->literals;
int changeover;
/*
* Check params.
*/
if (objc != 4) {
| > > | | | < < > | < < < | < < < < < < < < < < | 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 |
{
TclDateFields fields;
Tcl_Obj *dict;
ClockClientData *data = clientData;
Tcl_Obj *const *literals = data->literals;
int changeover;
fields.tzName = NULL;
/*
* Check params.
*/
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "seconds timezone changeover");
return TCL_ERROR;
}
if (TclGetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK
|| TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) {
return TCL_ERROR;
}
/*
* fields.seconds could be an unsigned number that overflowed. Make sure
* that it isn't.
*/
if (objv[1]->typePtr == &tclBignumType) {
Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]);
return TCL_ERROR;
}
/* Extract fields */
if (ClockGetDateFields(clientData, interp, &fields, objv[2],
changeover) != TCL_OK) {
return TCL_ERROR;
}
/* Make dict of fields */
dict = Tcl_NewDictObj();
Tcl_DictObjPut(NULL, dict, literals[LIT_LOCALSECONDS],
Tcl_NewWideIntObj(fields.localSeconds));
Tcl_DictObjPut(NULL, dict, literals[LIT_SECONDS],
Tcl_NewWideIntObj(fields.seconds));
Tcl_DictObjPut(NULL, dict, literals[LIT_TZNAME], fields.tzName);
|
| ︙ | ︙ | |||
507 508 509 510 511 512 513 514 515 516 517 518 519 520 |
Tcl_NewIntObj(fields.iso8601Year));
Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601WEEK],
Tcl_NewIntObj(fields.iso8601Week));
Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFWEEK],
Tcl_NewIntObj(fields.dayOfWeek));
Tcl_SetObjResult(interp, dict);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ClockGetjuliandayfromerayearmonthdayObjCmd --
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 |
Tcl_NewIntObj(fields.iso8601Year));
Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601WEEK],
Tcl_NewIntObj(fields.iso8601Week));
Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFWEEK],
Tcl_NewIntObj(fields.dayOfWeek));
Tcl_SetObjResult(interp, dict);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ClockGetDateFields --
*
* Converts given UTC time (seconds in a TclDateFields structure)
* to local time and determines the values that clock routines will
* use in scanning or formatting a date.
*
* Results:
* Date-time values are stored in structure "fields".
* Returns a standard Tcl result.
*
*----------------------------------------------------------------------
*/
int
ClockGetDateFields(
ClientData clientData, /* Client data of the interpreter */
Tcl_Interp *interp, /* Tcl interpreter */
TclDateFields *fields, /* Pointer to result fields, where
* fields->seconds contains date to extract */
Tcl_Obj *timezoneObj, /* Time zone object or NULL for gmt */
int changeover) /* Julian Day Number */
{
/*
* Convert UTC time to local.
*/
if (ConvertUTCToLocal(clientData, interp, fields, timezoneObj,
changeover) != TCL_OK) {
return TCL_ERROR;
}
/*
* Extract Julian day.
*/
fields->julianDay = (int) ((fields->localSeconds + JULIAN_SEC_POSIX_EPOCH)
/ SECONDS_PER_DAY);
/*
* Convert to Julian or Gregorian calendar.
*/
GetGregorianEraYearDay(fields, changeover);
GetMonthDay(fields);
GetYearWeekDay(fields, changeover);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ClockGetjuliandayfromerayearmonthdayObjCmd --
|
| ︙ | ︙ | |||
586 587 588 589 590 591 592 593 594 595 596 597 598 599 |
Tcl_Obj *dict;
ClockClientData *data = clientData;
Tcl_Obj *const *literals = data->literals;
int changeover;
int copied = 0;
int status;
int era = 0;
/*
* Check params.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
| > > | 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 |
Tcl_Obj *dict;
ClockClientData *data = clientData;
Tcl_Obj *const *literals = data->literals;
int changeover;
int copied = 0;
int status;
int era = 0;
fields.tzName = NULL;
/*
* Check params.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
|
| ︙ | ︙ | |||
671 672 673 674 675 676 677 678 679 680 681 682 683 684 |
ClockClientData *data = clientData;
Tcl_Obj *const *literals = data->literals;
int changeover;
int copied = 0;
int status;
int era = 0;
/*
* Check params.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
return TCL_ERROR;
| > > | 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 |
ClockClientData *data = clientData;
Tcl_Obj *const *literals = data->literals;
int changeover;
int copied = 0;
int status;
int era = 0;
fields.tzName = NULL;
/*
* Check params.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
return TCL_ERROR;
|
| ︙ | ︙ | |||
738 739 740 741 742 743 744 745 746 |
* in the interpreter result on failure.
*
*----------------------------------------------------------------------
*/
static int
ConvertLocalToUTC(
Tcl_Interp *interp, /* Tcl interpreter */
TclDateFields *fields, /* Fields of the time */
| > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > | > > > > > > > > > > > | 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 |
* in the interpreter result on failure.
*
*----------------------------------------------------------------------
*/
static int
ConvertLocalToUTC(
ClientData clientData, /* Client data of the interpreter */
Tcl_Interp *interp, /* Tcl interpreter */
TclDateFields *fields, /* Fields of the time */
Tcl_Obj *timezoneObj, /* Time zone */
int changeover) /* Julian Day of the Gregorian transition */
{
ClockClientData *dataPtr = clientData;
Tcl_Obj *tzdata; /* Time zone data */
int rowc; /* Number of rows in tzdata */
Tcl_Obj **rowv; /* Pointers to the rows */
Tcl_WideInt seconds;
/* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */
if (timezoneObj == dataPtr->GMTSetupTimeZone && dataPtr->GMTSetupTimeZone != NULL) {
fields->seconds = fields->localSeconds;
fields->tzOffset = 0;
return TCL_OK;
}
/*
* Check cacheable conversion could be used
* (last-period Local2UTC cache within the same TZ)
*/
seconds = fields->localSeconds - dataPtr->Local2UTC.tzOffset;
if ( timezoneObj == dataPtr->Local2UTC.timezoneObj
&& ( fields->localSeconds == dataPtr->Local2UTC.localSeconds
|| ( seconds >= dataPtr->Local2UTC.rangesVal[0]
&& seconds < dataPtr->Local2UTC.rangesVal[1])
)
&& changeover == dataPtr->Local2UTC.changeover
) {
/* the same time zone and offset (UTC time inside the last minute) */
fields->tzOffset = dataPtr->Local2UTC.tzOffset;
fields->seconds = seconds;
return TCL_OK;
}
/*
* Check cacheable back-conversion could be used
* (last-period UTC2Local cache within the same TZ)
*/
seconds = fields->localSeconds - dataPtr->UTC2Local.tzOffset;
if ( timezoneObj == dataPtr->UTC2Local.timezoneObj
&& ( seconds == dataPtr->UTC2Local.seconds
|| ( seconds >= dataPtr->UTC2Local.rangesVal[0]
&& seconds < dataPtr->UTC2Local.rangesVal[1])
)
&& changeover == dataPtr->UTC2Local.changeover
) {
/* the same time zone and offset (UTC time inside the last minute) */
fields->tzOffset = dataPtr->UTC2Local.tzOffset;
fields->seconds = seconds;
return TCL_OK;
}
/*
* Unpack the tz data.
*/
tzdata = ClockGetTZData(clientData, interp, timezoneObj);
if (tzdata == NULL) {
return TCL_ERROR;
}
if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
return TCL_ERROR;
}
/*
* Special case: If the time zone is :localtime, the tzdata will be empty.
* Use 'mktime' to convert the time to local
*/
if (rowc == 0) {
dataPtr->Local2UTC.rangesVal[0] = 0;
dataPtr->Local2UTC.rangesVal[1] = 0;
if (ConvertLocalToUTCUsingC(interp, fields, changeover) != TCL_OK) {
return TCL_ERROR;
};
} else {
if (ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv,
dataPtr->Local2UTC.rangesVal) != TCL_OK) {
return TCL_ERROR;
};
}
/* Cache the last conversion */
Tcl_SetObjRef(dataPtr->Local2UTC.timezoneObj, timezoneObj);
dataPtr->Local2UTC.localSeconds = fields->localSeconds;
dataPtr->Local2UTC.changeover = changeover;
dataPtr->Local2UTC.tzOffset = fields->tzOffset;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ConvertLocalToUTCUsingTable --
*
|
| ︙ | ︙ | |||
789 790 791 792 793 794 795 |
*/
static int
ConvertLocalToUTCUsingTable(
Tcl_Interp *interp, /* Tcl interpreter */
TclDateFields *fields, /* Time to convert, with 'seconds' filled in */
int rowc, /* Number of points at which time changes */
| | > | 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 |
*/
static int
ConvertLocalToUTCUsingTable(
Tcl_Interp *interp, /* Tcl interpreter */
TclDateFields *fields, /* Time to convert, with 'seconds' filled in */
int rowc, /* Number of points at which time changes */
Tcl_Obj *const rowv[], /* Points at which time changes */
Tcl_WideInt rangesVal[2]) /* Return bounds for time period */
{
Tcl_Obj *row;
int cellc;
Tcl_Obj **cellv;
int have[8];
int nHave = 0;
int i;
|
| ︙ | ︙ | |||
813 814 815 816 817 818 819 |
* Saving Time transition.
*/
found = 0;
fields->tzOffset = 0;
fields->seconds = fields->localSeconds;
while (!found) {
| | > | 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 |
* Saving Time transition.
*/
found = 0;
fields->tzOffset = 0;
fields->seconds = fields->localSeconds;
while (!found) {
row = LookupLastTransition(interp, fields->seconds, rowc, rowv,
rangesVal);
if ((row == NULL)
|| TclListObjGetElements(interp, row, &cellc,
&cellv) != TCL_OK
|| TclGetIntFromObj(interp, cellv[1],
&fields->tzOffset) != TCL_OK) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
838 839 840 841 842 843 844 845 846 847 848 849 850 851 |
}
have[nHave++] = fields->tzOffset;
}
fields->seconds = fields->localSeconds - fields->tzOffset;
}
fields->tzOffset = have[i];
fields->seconds = fields->localSeconds - fields->tzOffset;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ConvertLocalToUTCUsingC --
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 |
}
have[nHave++] = fields->tzOffset;
}
fields->seconds = fields->localSeconds - fields->tzOffset;
}
fields->tzOffset = have[i];
fields->seconds = fields->localSeconds - fields->tzOffset;
#if 0
/* currently unused, test purposes only */
/*
* Convert back from UTC, if local times are different - wrong local time
* (local time seems to be in between DST-hole).
*/
if (fields->tzOffset) {
int corrOffset;
Tcl_WideInt backCompVal;
/* check DST-hole interval contains UTC time */
TclGetWideIntFromObj(NULL, cellv[0], &backCompVal);
if ( fields->seconds >= backCompVal - fields->tzOffset
&& fields->seconds <= backCompVal + fields->tzOffset
) {
row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
if (row == NULL ||
TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK ||
TclGetIntFromObj(interp, cellv[1], &corrOffset) != TCL_OK) {
return TCL_ERROR;
}
if (fields->localSeconds != fields->seconds + corrOffset) {
Tcl_Panic("wrong local time %ld by LocalToUTC conversion,"
" local time seems to be in between DST-hole",
fields->localSeconds);
/* correcting offset * /
fields->tzOffset -= corrOffset;
fields->seconds += fields->tzOffset;
*/
}
}
}
#endif
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ConvertLocalToUTCUsingC --
|
| ︙ | ︙ | |||
939 940 941 942 943 944 945 | * * Side effects: * Populates the 'tzName' and 'tzOffset' fields. * *---------------------------------------------------------------------- */ | | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > | > > | > > > > > > > > > | 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 |
*
* Side effects:
* Populates the 'tzName' and 'tzOffset' fields.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE int
ConvertUTCToLocal(
ClientData clientData, /* Client data of the interpreter */
Tcl_Interp *interp, /* Tcl interpreter */
TclDateFields *fields, /* Fields of the time */
Tcl_Obj *timezoneObj, /* Time zone */
int changeover) /* Julian Day of the Gregorian transition */
{
ClockClientData *dataPtr = clientData;
Tcl_Obj *tzdata; /* Time zone data */
int rowc; /* Number of rows in tzdata */
Tcl_Obj **rowv; /* Pointers to the rows */
/* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */
if (timezoneObj == dataPtr->GMTSetupTimeZone
&& dataPtr->GMTSetupTimeZone != NULL
&& dataPtr->GMTSetupTZData != NULL
) {
fields->localSeconds = fields->seconds;
fields->tzOffset = 0;
if ( TclListObjGetElements(interp, dataPtr->GMTSetupTZData, &rowc, &rowv) != TCL_OK
|| Tcl_ListObjIndex(interp, rowv[0], 3, &fields->tzName) != TCL_OK) {
return TCL_ERROR;
}
Tcl_IncrRefCount(fields->tzName);
return TCL_OK;
}
/*
* Check cacheable conversion could be used
* (last-period UTC2Local cache within the same TZ)
*/
if ( timezoneObj == dataPtr->UTC2Local.timezoneObj
&& ( fields->seconds == dataPtr->UTC2Local.seconds
|| ( fields->seconds >= dataPtr->UTC2Local.rangesVal[0]
&& fields->seconds < dataPtr->UTC2Local.rangesVal[1])
)
&& changeover == dataPtr->UTC2Local.changeover
) {
/* the same time zone and offset (UTC time inside the last minute) */
Tcl_SetObjRef(fields->tzName, dataPtr->UTC2Local.tzName);
fields->tzOffset = dataPtr->UTC2Local.tzOffset;
fields->localSeconds = fields->seconds + fields->tzOffset;
return TCL_OK;
}
/*
* Unpack the tz data.
*/
tzdata = ClockGetTZData(clientData, interp, timezoneObj);
if (tzdata == NULL) {
return TCL_ERROR;
}
if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
return TCL_ERROR;
}
/*
* Special case: If the time zone is :localtime, the tzdata will be empty.
* Use 'localtime' to convert the time to local
*/
if (rowc == 0) {
dataPtr->UTC2Local.rangesVal[0] = 0;
dataPtr->UTC2Local.rangesVal[1] = 0;
if (ConvertUTCToLocalUsingC(interp, fields, changeover) != TCL_OK) {
return TCL_ERROR;
}
} else {
if (ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv,
dataPtr->UTC2Local.rangesVal) != TCL_OK) {
return TCL_ERROR;
}
}
/* Cache the last conversion */
Tcl_SetObjRef(dataPtr->UTC2Local.timezoneObj, timezoneObj);
dataPtr->UTC2Local.seconds = fields->seconds;
dataPtr->UTC2Local.changeover = changeover;
dataPtr->UTC2Local.tzOffset = fields->tzOffset;
Tcl_SetObjRef(dataPtr->UTC2Local.tzName, fields->tzName);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ConvertUTCToLocalUsingTable --
*
|
| ︙ | ︙ | |||
993 994 995 996 997 998 999 |
static int
ConvertUTCToLocalUsingTable(
Tcl_Interp *interp, /* Tcl interpreter */
TclDateFields *fields, /* Fields of the date */
int rowc, /* Number of rows in the conversion table
* (>= 1) */
| | > | | < | 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 |
static int
ConvertUTCToLocalUsingTable(
Tcl_Interp *interp, /* Tcl interpreter */
TclDateFields *fields, /* Fields of the date */
int rowc, /* Number of rows in the conversion table
* (>= 1) */
Tcl_Obj *const rowv[], /* Rows of the conversion table */
Tcl_WideInt rangesVal[2]) /* Return bounds for time period */
{
Tcl_Obj *row; /* Row containing the current information */
int cellc; /* Count of cells in the row (must be 4) */
Tcl_Obj **cellv; /* Pointers to the cells */
/*
* Look up the nearest transition time.
*/
row = LookupLastTransition(interp, fields->seconds, rowc, rowv, rangesVal);
if (row == NULL ||
TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK ||
TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) {
return TCL_ERROR;
}
/*
* Convert the time.
*/
Tcl_SetObjRef(fields->tzName, cellv[3]);
fields->localSeconds = fields->seconds + fields->tzOffset;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1108 1109 1110 1111 1112 1113 1114 |
sprintf(buffer+1, "%02d", diff / 3600);
diff %= 3600;
sprintf(buffer+3, "%02d", diff / 60);
diff %= 60;
if (diff > 0) {
sprintf(buffer+5, "%02d", diff);
}
| | < | | > | | | | < | > > > > > > > > > | 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 |
sprintf(buffer+1, "%02d", diff / 3600);
diff %= 3600;
sprintf(buffer+3, "%02d", diff / 60);
diff %= 60;
if (diff > 0) {
sprintf(buffer+5, "%02d", diff);
}
Tcl_SetObjRef(fields->tzName, Tcl_NewStringObj(buffer, -1));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* LookupLastTransition --
*
* Given a UTC time and a tzdata array, looks up the last transition on
* or before the given time.
*
* Results:
* Returns a pointer to the row, or NULL if an error occurs.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE Tcl_Obj *
LookupLastTransition(
Tcl_Interp *interp, /* Interpreter for error messages */
Tcl_WideInt tick, /* Time from the epoch */
int rowc, /* Number of rows of tzdata */
Tcl_Obj *const *rowv, /* Rows in tzdata */
Tcl_WideInt rangesVal[2]) /* Return bounds for time period */
{
int l = 0;
int u;
Tcl_Obj *compObj;
Tcl_WideInt compVal, fromVal = tick, toVal = tick;
/*
* Examine the first row to make sure we're in bounds.
*/
if (Tcl_ListObjIndex(interp, rowv[0], 0, &compObj) != TCL_OK
|| TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
return NULL;
}
/*
* Bizarre case - first row doesn't begin at MIN_WIDE_INT. Return it
* anyway.
*/
if (tick < compVal) {
goto done;
}
/*
* Binary-search to find the transition.
*/
u = rowc-1;
while (l < u) {
int m = (l + u + 1) / 2;
if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK ||
TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
return NULL;
}
if (tick >= compVal) {
l = m;
fromVal = compVal;
} else {
u = m-1;
toVal = compVal;
}
}
done:
if (rangesVal) {
rangesVal[0] = fromVal;
rangesVal[1] = toVal;
}
return rowv[l];
}
/*
*----------------------------------------------------------------------
*
* GetYearWeekDay --
|
| ︙ | ︙ | |||
1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 |
GetYearWeekDay(
TclDateFields *fields, /* Date to convert, must have 'julianDay' */
int changeover) /* Julian Day Number of the Gregorian
* transition */
{
TclDateFields temp;
int dayOfFiscalYear;
/*
* Find the given date, minus three days, plus one year. That date's
* iso8601 year is an upper bound on the ISO8601 year of the given date.
*/
temp.julianDay = fields->julianDay - 3;
| > > | 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 |
GetYearWeekDay(
TclDateFields *fields, /* Date to convert, must have 'julianDay' */
int changeover) /* Julian Day Number of the Gregorian
* transition */
{
TclDateFields temp;
int dayOfFiscalYear;
temp.tzName = NULL;
/*
* Find the given date, minus three days, plus one year. That date's
* iso8601 year is an upper bound on the ISO8601 year of the given date.
*/
temp.julianDay = fields->julianDay - 3;
|
| ︙ | ︙ | |||
1412 1413 1414 1415 1416 1417 1418 | * * Side effects: * Stores 'julianDay' in the fields. * *---------------------------------------------------------------------- */ | | > > | 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 |
*
* Side effects:
* Stores 'julianDay' in the fields.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE void
GetJulianDayFromEraYearWeekDay(
TclDateFields *fields, /* Date to convert */
int changeover) /* Julian Day Number of the Gregorian
* transition */
{
int firstMonday; /* Julian day number of week 1, day 1 in the
* given year */
TclDateFields firstWeek;
firstWeek.tzName = NULL;
/*
* Find January 4 in the ISO8601 year, which will always be in week 1.
*/
firstWeek.era = fields->era;
firstWeek.year = fields->iso8601Year;
|
| ︙ | ︙ | |||
1463 1464 1465 1466 1467 1468 1469 | * * Side effects: * Stores day number in 'julianDay' * *---------------------------------------------------------------------- */ | | | 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 |
*
* Side effects:
* Stores day number in 'julianDay'
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE void
GetJulianDayFromEraYearMonthDay(
TclDateFields *fields, /* Date to convert */
int changeover) /* Gregorian transition date as a Julian Day */
{
int year, ym1, month, mm1, q, r, ym1o4, ym1o100, ym1o400;
if (fields->era == BCE) {
|
| ︙ | ︙ | |||
1517 1518 1519 1520 1521 1522 1523 |
ym1o4 = ym1 / 4;
#else
/*
* Have to make sure quotient is truncated towards 0 when negative.
* See above bug for details. The casts are necessary.
*/
if (ym1 >= 0)
| | | | 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 |
ym1o4 = ym1 / 4;
#else
/*
* Have to make sure quotient is truncated towards 0 when negative.
* See above bug for details. The casts are necessary.
*/
if (ym1 >= 0)
ym1o4 = ym1 / 4;
else {
ym1o4 = - (int) (((unsigned int) -ym1) / 4);
}
#endif
if (ym1 % 4 < 0) {
ym1o4--;
}
ym1o100 = ym1 / 100;
if (ym1 % 100 < 0) {
|
| ︙ | ︙ | |||
1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 |
+ ym1o4;
}
}
/*
*----------------------------------------------------------------------
*
* IsGregorianLeapYear --
*
* Tests whether a given year is a leap year, in either Julian or
* Gregorian calendar.
*
* Results:
* Returns 1 for a leap year, 0 otherwise.
*
*----------------------------------------------------------------------
*/
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | < < | 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 |
+ ym1o4;
}
}
/*
*----------------------------------------------------------------------
*
* GetJulianDayFromEraYearDay --
*
* Given era, year, and dayOfYear (in TclDateFields), and the
* Gregorian transition date, computes the Julian Day Number.
*
* Results:
* None.
*
* Side effects:
* Stores day number in 'julianDay'
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE void
GetJulianDayFromEraYearDay(
TclDateFields *fields, /* Date to convert */
int changeover) /* Gregorian transition date as a Julian Day */
{
int year, ym1;
/* Get absolute year number from the civil year */
if (fields->era == BCE) {
year = 1 - fields->year;
} else {
year = fields->year;
}
ym1 = year - 1;
/* Try the Gregorian calendar first. */
fields->gregorian = 1;
fields->julianDay =
1721425
+ fields->dayOfYear
+ ( 365 * ym1 )
+ ( ym1 / 4 )
- ( ym1 / 100 )
+ ( ym1 / 400 );
/* If the date is before the Gregorian change, use the Julian calendar. */
if ( fields->julianDay < changeover ) {
fields->gregorian = 0;
fields->julianDay =
1721423
+ fields->dayOfYear
+ ( 365 * ym1 )
+ ( ym1 / 4 );
}
}
/*
*----------------------------------------------------------------------
*
* IsGregorianLeapYear --
*
* Tests whether a given year is a leap year, in either Julian or
* Gregorian calendar.
*
* Results:
* Returns 1 for a leap year, 0 otherwise.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE int
IsGregorianLeapYear(
TclDateFields *fields) /* Date to test */
{
int year = fields->year;
if (fields->era == BCE) {
year = 1 - year;
}
if (year%4 != 0) {
return 0;
} else if (!(fields->gregorian)) {
return 1;
} else if (year%400 == 0) {
return 1;
|
| ︙ | ︙ | |||
1753 1754 1755 1756 1757 1758 1759 |
case 2:
if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
break;
default:
| | < | | 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 |
case 2:
if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
break;
default:
Tcl_WrongNumArgs(interp, 0, NULL, "clock clicks ?-switch?");
return TCL_ERROR;
}
switch (index) {
case CLICKS_MILLIS:
Tcl_GetTime(&now);
clicks = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000;
break;
case CLICKS_NATIVE:
#ifdef TCL_WIDE_CLICKS
clicks = TclpGetWideClicks();
#else
clicks = (Tcl_WideInt) TclpGetClicks();
#endif
break;
case CLICKS_MICROS:
clicks = TclpGetMicroseconds();
break;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(clicks));
return TCL_OK;
}
|
| ︙ | ︙ | |||
1807 1808 1809 1810 1811 1812 1813 |
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter values */
{
Tcl_Time now;
if (objc != 1) {
| | | 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 |
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter values */
{
Tcl_Time now;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 0, NULL, "clock milliseconds");
return TCL_ERROR;
}
Tcl_GetTime(&now);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
now.sec * 1000 + now.usec / 1000));
return TCL_OK;
}
|
| ︙ | ︙ | |||
1841 1842 1843 1844 1845 1846 1847 |
int
ClockMicrosecondsObjCmd(
ClientData clientData, /* Client data is unused */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter values */
{
| < < | < | < > > > > > > > > > > > | | | | < < < < | < < < < < < < < < > > | > | > | > > > > > > > > | | > | | < > < | < | < | < < < < > < < < > > > > > > > > | | | > > > > > | < > > | > > > | | | | | | > > > | > > > | < < < | | | > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > | > | > > | > | > > > | > > | 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 |
int
ClockMicrosecondsObjCmd(
ClientData clientData, /* Client data is unused */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter values */
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 0, NULL, "clock microseconds");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));
return TCL_OK;
}
static inline void
ClockInitFmtScnArgs(
ClientData clientData,
Tcl_Interp *interp,
ClockFmtScnCmdArgs *opts)
{
memset(opts, 0, sizeof(*opts));
opts->clientData = clientData;
opts->interp = interp;
}
/*
*-----------------------------------------------------------------------------
*
* ClockParseFmtScnArgs --
*
* Parses the arguments for [clock scan] and [clock format].
*
* Results:
* Returns a standard Tcl result, and stores parsed options
* (format, the locale, timezone and base) in structure "opts".
*
*-----------------------------------------------------------------------------
*/
#define CLC_FMT_ARGS (0)
#define CLC_SCN_ARGS (1 << 0)
#define CLC_ADD_ARGS (1 << 1)
static int
ClockParseFmtScnArgs(
register
ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */
TclDateFields *date, /* Extracted date-time corresponding base
* (by scan or add) resp. clockval (by format) */
int objc, /* Parameter count */
Tcl_Obj *const objv[], /* Parameter vector */
int flags /* Flags, differentiates between format, scan, add */
) {
Tcl_Interp *interp = opts->interp;
ClockClientData *dataPtr = opts->clientData;
int gmtFlag = 0;
static const char *const options[] = {
"-format", "-gmt", "-locale",
"-timezone", "-base", NULL
};
enum optionInd {
CLC_ARGS_FORMAT, CLC_ARGS_GMT, CLC_ARGS_LOCALE,
CLC_ARGS_TIMEZONE, CLC_ARGS_BASE
};
int optionIndex; /* Index of an option. */
int saw = 0; /* Flag == 1 if option was seen already. */
int i;
Tcl_WideInt baseVal; /* Base time, expressed in seconds from the Epoch */
/* clock value (as current base) */
if ( !(flags & (CLC_SCN_ARGS)) ) {
opts->baseObj = objv[1];
saw |= (1 << CLC_ARGS_BASE);
}
/*
* Extract values for the keywords.
*/
for (i = 2; i < objc; i+=2) {
/* bypass integers (offsets) by "clock add" */
if (flags & CLC_ADD_ARGS) {
Tcl_WideInt num;
if (TclGetWideIntFromObj(NULL, objv[i], &num) == TCL_OK) {
continue;
}
}
/* get option */
if (Tcl_GetIndexFromObj(interp, objv[i], options,
"option", 0, &optionIndex) != TCL_OK) {
goto badOption;
}
/* if already specified */
if (saw & (1 << optionIndex)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\": doubly present",
TclGetString(objv[i]))
);
goto badOption;
}
switch (optionIndex) {
case CLC_ARGS_FORMAT:
if (flags & CLC_ADD_ARGS) {
goto badOptionMsg;
}
opts->formatObj = objv[i+1];
break;
case CLC_ARGS_GMT:
if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){
return TCL_ERROR;
}
break;
case CLC_ARGS_LOCALE:
opts->localeObj = objv[i+1];
break;
case CLC_ARGS_TIMEZONE:
opts->timezoneObj = objv[i+1];
break;
case CLC_ARGS_BASE:
if ( !(flags & (CLC_SCN_ARGS)) ) {
goto badOptionMsg;
}
opts->baseObj = objv[i+1];
break;
}
saw |= (1 << optionIndex);
}
/*
* Check options.
*/
if ((saw & (1 << CLC_ARGS_GMT))
&& (saw & (1 << CLC_ARGS_TIMEZONE))) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot use -gmt and -timezone in same call", -1));
Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL);
return TCL_ERROR;
}
if (gmtFlag) {
opts->timezoneObj = dataPtr->literals[LIT_GMT];
}
/* If time zone not specified use system time zone */
if ( opts->timezoneObj == NULL
|| TclGetString(opts->timezoneObj) == NULL
|| opts->timezoneObj->length == 0
) {
opts->timezoneObj = ClockGetSystemTimeZone(opts->clientData, interp);
if (opts->timezoneObj == NULL) {
return TCL_ERROR;
}
}
/* Setup timezone (normalize object if needed and load TZ on demand) */
opts->timezoneObj = ClockSetupTimeZone(opts->clientData, interp, opts->timezoneObj);
if (opts->timezoneObj == NULL) {
return TCL_ERROR;
}
/* Base (by scan or add) or clock value (by format) */
if (opts->baseObj != NULL) {
register Tcl_Obj *baseObj = opts->baseObj;
/* bypass integer recognition if looks like option "-now" */
if (
(baseObj->length == 4 && baseObj->bytes && *(baseObj->bytes+1) == 'n') ||
TclGetWideIntFromObj(NULL, baseObj, &baseVal) != TCL_OK
) {
/* we accept "-now" as current date-time */
static const char *const nowOpts[] = {
"-now", NULL
};
int idx;
if (Tcl_GetIndexFromObj(NULL, baseObj, nowOpts, "seconds or -now",
TCL_EXACT, &idx) == TCL_OK
) {
goto baseNow;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
Tcl_GetString(baseObj)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
i = 1;
goto badOption;
}
/*
* seconds could be an unsigned number that overflowed. Make sure
* that it isn't.
*/
if (baseObj->typePtr == &tclBignumType) {
Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]);
return TCL_ERROR;
}
} else {
baseNow:
{
Tcl_Time now;
Tcl_GetTime(&now);
baseVal = (Tcl_WideInt) now.sec;
}
}
/*
* Extract year, month and day from the base time for the parser to use as
* defaults
*/
/* check base fields already cached (by TZ, last-second cache) */
if ( dataPtr->lastBase.timezoneObj == opts->timezoneObj
&& dataPtr->lastBase.Date.seconds == baseVal) {
memcpy(date, &dataPtr->lastBase.Date, ClockCacheableDateFieldsSize);
} else {
/* extact fields from base */
date->seconds = baseVal;
if (ClockGetDateFields(opts->clientData, interp, date, opts->timezoneObj,
GREGORIAN_CHANGE_DATE) != TCL_OK) { /* TODO - GREGORIAN_CHANGE_DATE should be locale-dependent */
return TCL_ERROR;
}
/* cache last base */
memcpy(&dataPtr->lastBase.Date, date, ClockCacheableDateFieldsSize);
Tcl_SetObjRef(dataPtr->lastBase.timezoneObj, opts->timezoneObj);
}
return TCL_OK;
badOptionMsg:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\": unexpected for command \"%s\"",
TclGetString(objv[i]), TclGetString(objv[0]))
);
badOption:
Tcl_SetErrorCode(interp, "CLOCK", "badOption",
i < objc ? Tcl_GetString(objv[i]) : NULL, NULL);
return TCL_ERROR;
}
/*----------------------------------------------------------------------
*
* ClockFormatObjCmd -- , clock format --
*
* This function is invoked to process the Tcl "clock format" command.
*
* Formats a count of seconds since the Posix Epoch as a time of day.
*
* The 'clock format' command formats times of day for output. Refer
* to the user documentation to see what it does.
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
ClockFormatObjCmd(
ClientData clientData, /* Client data containing literal pool */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const objv[]) /* Parameter values */
{
ClockClientData *dataPtr = clientData;
int ret;
ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */
DateFormat dateFmt; /* Common structure used for formatting */
/* even number of arguments */
if ((objc & 1) == 1) {
Tcl_WrongNumArgs(interp, 0, NULL, "clock format clockval|-now "
"?-format string? "
"?-gmt boolean? "
"?-locale LOCALE? ?-timezone ZONE?");
Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL);
return TCL_ERROR;
}
memset(&dateFmt, 0, sizeof(dateFmt));
/*
* Extract values for the keywords.
*/
ClockInitFmtScnArgs(clientData, interp, &opts);
ret = ClockParseFmtScnArgs(&opts, &dateFmt.date, objc, objv,
CLC_FMT_ARGS);
if (ret != TCL_OK) {
goto done;
}
/* Default format */
if (opts.formatObj == NULL) {
opts.formatObj = dataPtr->literals[LIT__DEFAULT_FORMAT];
}
/* Use compiled version of Format - */
ret = ClockFormat(&dateFmt, &opts);
done:
Tcl_UnsetObjRef(dateFmt.date.tzName);
if (ret != TCL_OK) {
return ret;
}
return TCL_OK;
}
/*----------------------------------------------------------------------
*
* ClockScanObjCmd -- , clock scan --
*
* This function is invoked to process the Tcl "clock scan" command.
*
* Inputs a count of seconds since the Posix Epoch as a time of day.
*
* The 'clock scan' command scans times of day on input. Refer to the
* user documentation to see what it does.
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
ClockScanObjCmd(
ClientData clientData, /* Client data containing literal pool */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const objv[]) /* Parameter values */
{
int ret;
ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */
DateInfo yy; /* Common structure used for parsing */
DateInfo *info = &yy;
/* even number of arguments */
if ((objc & 1) == 1) {
Tcl_WrongNumArgs(interp, 0, NULL, "clock scan string "
"?-base seconds? "
"?-format string? "
"?-gmt boolean? "
"?-locale LOCALE? ?-timezone ZONE?");
Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL);
return TCL_ERROR;
}
ClockInitDateInfo(&yy);
/*
* Extract values for the keywords.
*/
ClockInitFmtScnArgs(clientData, interp, &opts);
ret = ClockParseFmtScnArgs(&opts, &yy.date, objc, objv,
CLC_SCN_ARGS);
if (ret != TCL_OK) {
goto done;
}
/* seconds are in localSeconds (relative base date), so reset time here */
yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24;
/* If free scan */
if (opts.formatObj == NULL) {
/* Use compiled version of FreeScan - */
/* [SB] TODO: Perhaps someday we'll localize the legacy code. Right now, it's not localized. */
if (opts.localeObj != NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("legacy [clock scan] does not support -locale", -1));
Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL);
return TCL_ERROR;
}
ret = ClockFreeScan(&yy, objv[1], &opts);
}
else {
/* Use compiled version of Scan - */
ret = ClockScan(&yy, objv[1], &opts);
}
/* Convert date info structure into UTC seconds */
if (ret == TCL_OK) {
ret = ClockScanCommit(clientData, &yy, &opts);
}
done:
Tcl_UnsetObjRef(yy.date.tzName);
if (ret != TCL_OK) {
return ret;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yy.date.seconds));
return TCL_OK;
}
/*----------------------------------------------------------------------
*
* ClockScanCommit --
*
* Converts date info structure into UTC seconds.
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
ClockScanCommit(
ClientData clientData, /* Client data containing literal pool */
register DateInfo *info, /* Clock scan info structure */
register
ClockFmtScnCmdArgs *opts) /* Format, locale, timezone and base */
{
/* If needed assemble julianDay using year, month, etc. */
if (info->flags & CLF_ASSEMBLE_JULIANDAY) {
if ((info->flags & CLF_ISO8601)) {
GetJulianDayFromEraYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE);
}
else
if (!(info->flags & CLF_DAYOFYEAR)) {
GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE);
} else {
GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
}
}
/* some overflow checks, if not extended */
if (!(opts->flags & CLF_EXTENDED)) {
if (yydate.julianDay > 5373484) {
Tcl_SetObjResult(opts->interp, Tcl_NewStringObj(
"requested date too large to represent", -1));
Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL);
return TCL_ERROR;
}
}
/* Local seconds to UTC (stored in yydate.seconds) */
if (info->flags & (CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY)) {
yydate.localSeconds =
-210866803200L
+ ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay )
+ ( yySeconds % SECONDS_PER_DAY );
}
if (info->flags & (CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY|CLF_LOCALSEC)) {
if (ConvertLocalToUTC(clientData, opts->interp, &yydate, opts->timezoneObj,
GREGORIAN_CHANGE_DATE) != TCL_OK) {
return TCL_ERROR;
}
}
/* Increment UTC seconds with relative time */
yydate.seconds += yyRelSeconds;
return TCL_OK;
}
/*----------------------------------------------------------------------
*
* ClockFreeScan --
*
* Used by ClockScanObjCmd for free scanning without format.
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
ClockFreeScan(
register
DateInfo *info, /* Date fields used for parsing & converting
* simultaneously a yy-parse structure of the
* TclClockFreeScan */
Tcl_Obj *strObj, /* String containing the time to scan */
ClockFmtScnCmdArgs *opts) /* Command options */
{
Tcl_Interp *interp = opts->interp;
ClockClientData *dataPtr = opts->clientData;
int ret = TCL_ERROR;
/*
* Parse the date. The parser will fill a structure "info" with date,
* time, time zone, relative month/day/seconds, relative weekday, ordinal
* month.
* Notice that many yy-defines point to values in the "info" or "date"
* structure, e. g. yySeconds -> info->date.secondOfDay or
* yySeconds -> info->date.month (same as yydate.month)
*/
yyInput = Tcl_GetString(strObj);
if (TclClockFreeScan(interp, info) != TCL_OK) {
Tcl_Obj *msg = Tcl_NewObj();
Tcl_AppendPrintfToObj(msg, "unable to convert date-time string \"%s\": %s",
Tcl_GetString(strObj), TclGetString(Tcl_GetObjResult(interp)));
Tcl_SetObjResult(interp, msg);
goto done;
}
/*
* If the caller supplied a date in the string, update the date with
* the value. If the caller didn't specify a time with the date, default to
* midnight.
*/
if (yyHaveDate) {
if (yyYear < 100) {
if (yyYear >= dataPtr->yearOfCenturySwitch) {
yyYear -= 100;
}
yyYear += dataPtr->currentYearCentury;
}
yydate.era = CE;
if (yyHaveTime == 0) {
yyHaveTime = -1;
}
info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS;
}
/*
* If the caller supplied a time zone in the string, make it into a time
* zone indicator of +-hhmm and setup this time zone.
*/
if (yyHaveZone) {
Tcl_Obj *tzObjStor = NULL;
int minEast = -yyTimezone;
int dstFlag = 1 - yyDSTmode;
tzObjStor = ClockFormatNumericTimeZone(
60 * minEast + 3600 * dstFlag);
Tcl_IncrRefCount(tzObjStor);
opts->timezoneObj = ClockSetupTimeZone(dataPtr, interp, tzObjStor);
Tcl_DecrRefCount(tzObjStor);
if (opts->timezoneObj == NULL) {
goto done;
}
// Tcl_SetObjRef(yydate.tzName, opts->timezoneObj);
info->flags |= CLF_ASSEMBLE_SECONDS;
}
/*
* Assemble date, time, zone into seconds-from-epoch
*/
if (yyHaveTime == -1) {
yySeconds = 0;
info->flags |= CLF_ASSEMBLE_SECONDS;
}
else
if (yyHaveTime) {
yySeconds = ToSeconds(yyHour, yyMinutes,
yySeconds, yyMeridian);
info->flags |= CLF_ASSEMBLE_SECONDS;
}
else
if ( (yyHaveDay && !yyHaveDate)
|| yyHaveOrdinalMonth
|| ( yyHaveRel
&& ( yyRelMonth != 0
|| yyRelDay != 0 ) )
) {
yySeconds = 0;
info->flags |= CLF_ASSEMBLE_SECONDS;
}
else {
yySeconds = yydate.localSeconds % SECONDS_PER_DAY;
}
/*
* Do relative times
*/
ret = ClockCalcRelTime(info, opts);
/* Free scanning completed - date ready */
done:
return ret;
}
/*----------------------------------------------------------------------
*
* ClockCalcRelTime --
*
* Used for calculating of relative times.
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
ClockCalcRelTime(
register
DateInfo *info, /* Date fields used for converting */
ClockFmtScnCmdArgs *opts) /* Command options */
{
/*
* Because some calculations require in-between conversion of the
* julian day, we can repeat this processing multiple times
*/
repeat_rel:
if (yyHaveRel) {
/*
* Relative conversion normally possible in UTC time only, because
* of possible wrong local time increment if ignores in-between DST-hole.
* (see test-cases clock-34.53, clock-34.54).
* So increment date in julianDay, but time inside day in UTC (seconds).
*/
/* add months (or years in months) */
if (yyRelMonth != 0) {
int m, h;
/* if needed extract year, month, etc. again */
if (info->flags & CLF_ASSEMBLE_DATE) {
GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
GetMonthDay(&yydate);
GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE);
info->flags &= ~CLF_ASSEMBLE_DATE;
}
/* add the requisite number of months */
yyMonth += yyRelMonth - 1;
yyYear += yyMonth / 12;
m = yyMonth % 12;
yyMonth = m + 1;
/* if the day doesn't exist in the current month, repair it */
h = hath[IsGregorianLeapYear(&yydate)][m];
if (yyDay > h) {
yyDay = h;
}
/* on demand (lazy) assemble julianDay using new year, month, etc. */
info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS;
yyRelMonth = 0;
}
/* add days (or other parts aligned to days) */
if (yyRelDay) {
/* assemble julianDay using new year, month, etc. */
if (info->flags & CLF_ASSEMBLE_JULIANDAY) {
GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE);
info->flags &= ~CLF_ASSEMBLE_JULIANDAY;
}
yydate.julianDay += yyRelDay;
/* julianDay was changed, on demand (lazy) extract year, month, etc. again */
info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS;
yyRelDay = 0;
}
/* relative time (seconds), if exceeds current date, do the day conversion and
* leave rest of the increment in yyRelSeconds to add it hereafter in UTC seconds */
if (yyRelSeconds) {
int newSecs = yySeconds + yyRelSeconds;
/* if seconds increment outside of current date, increment day */
if (newSecs / SECONDS_PER_DAY != yySeconds / SECONDS_PER_DAY) {
yyRelDay += newSecs / SECONDS_PER_DAY;
yySeconds = 0;
yyRelSeconds = newSecs % SECONDS_PER_DAY;
goto repeat_rel;
}
}
yyHaveRel = 0;
}
/*
* Do relative (ordinal) month
*/
if (yyHaveOrdinalMonth) {
int monthDiff;
/* if needed extract year, month, etc. again */
if (info->flags & CLF_ASSEMBLE_DATE) {
GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
GetMonthDay(&yydate);
GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE);
info->flags &= ~CLF_ASSEMBLE_DATE;
}
if (yyMonthOrdinalIncr > 0) {
monthDiff = yyMonthOrdinal - yyMonth;
if (monthDiff <= 0) {
monthDiff += 12;
}
yyMonthOrdinalIncr--;
} else {
monthDiff = yyMonth - yyMonthOrdinal;
if (monthDiff >= 0) {
monthDiff -= 12;
}
yyMonthOrdinalIncr++;
}
/* process it further via relative times */
yyHaveRel++;
yyYear += yyMonthOrdinalIncr;
yyRelMonth += monthDiff;
yyHaveOrdinalMonth = 0;
info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS;
goto repeat_rel;
}
/*
* Do relative weekday
*/
if (yyHaveDay && !yyHaveDate) {
/* if needed assemble julianDay now */
if (info->flags & CLF_ASSEMBLE_JULIANDAY) {
GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE);
info->flags &= ~CLF_ASSEMBLE_JULIANDAY;
}
yydate.era = CE;
yydate.julianDay = WeekdayOnOrBefore(yyDayNumber, yydate.julianDay + 6)
+ 7 * yyDayOrdinal;
if (yyDayOrdinal > 0) {
yydate.julianDay -= 7;
}
info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS;
}
return TCL_OK;
}
/*----------------------------------------------------------------------
*
* ClockWeekdaysOffs --
*
* Get offset in days for the number of week days corresponding the
* given day of week (skipping Saturdays and Sundays).
*
*
* Results:
* Returns a day increment adjusted the given weekdays
*
*----------------------------------------------------------------------
*/
static inline int
ClockWeekdaysOffs(
register int dayOfWeek,
register int offs)
{
register int weeks, resDayOfWeek;
/* offset in days */
weeks = offs / 5;
offs = offs % 5;
/* compiler fix for negative offs - wrap (0, -1) -> (-1, 4) */
if (offs < 0) {
weeks--;
offs = 5 + offs;
}
offs += 7 * weeks;
/* resulting day of week */
{
register int day = (offs % 7);
/* compiler fix for negative offs - wrap (0, -1) -> (-1, 6) */
if (day < 0) {
day = 7 + day;
}
resDayOfWeek = dayOfWeek + day;
}
/* adjust if we start from a weekend */
if (dayOfWeek > 5) {
int adj = 5 - dayOfWeek;
offs += adj;
resDayOfWeek += adj;
}
/* adjust if we end up on a weekend */
if (resDayOfWeek > 5) {
offs += 2;
}
return offs;
}
/*----------------------------------------------------------------------
*
* ClockAddObjCmd -- , clock add --
*
* Adds an offset to a given time.
*
* Refer to the user documentation to see what it exactly does.
*
* Syntax:
* clock add clockval ?count unit?... ?-option value?
*
* Parameters:
* clockval -- Starting time value
* count -- Amount of a unit of time to add
* unit -- Unit of time to add, must be one of:
* years year months month weeks week
* days day hours hour minutes minute
* seconds second
*
* Options:
* -gmt BOOLEAN
* Flag synonymous with '-timezone :GMT'
* -timezone ZONE
* Name of the time zone in which calculations are to be done.
* -locale NAME
* Name of the locale in which calculations are to be done.
* Used to determine the Gregorian change date.
*
* Results:
* Returns a standard Tcl result with the given time adjusted
* by the given offset(s) in order.
*
* Notes:
* It is possible that adding a number of months or years will adjust the
* day of the month as well. For instance, the time at one month after
* 31 January is either 28 or 29 February, because February has fewer
* than 31 days.
*
*----------------------------------------------------------------------
*/
int
ClockAddObjCmd(
ClientData clientData, /* Client data containing literal pool */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const objv[]) /* Parameter values */
{
ClockClientData *dataPtr = clientData;
int ret;
ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */
DateInfo yy; /* Common structure used for parsing */
DateInfo *info = &yy;
/* add "week" to units also (because otherwise ambiguous) */
static const char *const units[] = {
"years", "months", "week", "weeks",
"days", "weekdays",
"hours", "minutes", "seconds",
NULL
};
enum unitInd {
CLC_ADD_YEARS, CLC_ADD_MONTHS, CLC_ADD_WEEK, CLC_ADD_WEEKS,
CLC_ADD_DAYS, CLC_ADD_WEEKDAYS,
CLC_ADD_HOURS, CLC_ADD_MINUTES, CLC_ADD_SECONDS
};
int unitIndex; /* Index of an option. */
int i;
Tcl_WideInt offs;
/* even number of arguments */
if ((objc & 1) == 1) {
Tcl_WrongNumArgs(interp, 0, NULL, "clock add clockval|-now ?number units?..."
"?-gmt boolean? "
"?-locale LOCALE? ?-timezone ZONE?");
Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL);
return TCL_ERROR;
}
ClockInitDateInfo(&yy);
/*
* Extract values for the keywords.
*/
ClockInitFmtScnArgs(clientData, interp, &opts);
ret = ClockParseFmtScnArgs(&opts, &yy.date, objc, objv,
CLC_ADD_ARGS);
if (ret != TCL_OK) {
goto done;
}
/* time together as seconds of the day */
yySeconds = yydate.localSeconds % SECONDS_PER_DAY;
/* seconds are in localSeconds (relative base date), so reset time here */
yyHour = 0; yyMinutes = 0; yyMeridian = MER24;
ret = TCL_ERROR;
/*
* Find each offset and process date increment
*/
for (i = 2; i < objc; i+=2) {
/* bypass not integers (options, allready processed above) */
if (TclGetWideIntFromObj(NULL, objv[i], &offs) != TCL_OK) {
continue;
}
if (objv[i]->typePtr == &tclBignumType) {
Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]);
goto done;
}
/* get unit */
if (Tcl_GetIndexFromObj(interp, objv[i+1], units, "unit", 0,
&unitIndex) != TCL_OK) {
goto done;
}
/* nothing to do if zero quantity */
if (!offs) {
continue;
}
/* if in-between conversion needed (already have relative date/time),
* correct date info, because the date may be changed,
* so refresh it now */
if ( yyHaveRel
&& ( unitIndex == CLC_ADD_WEEKDAYS
/* some months can be shorter as another */
|| yyRelMonth || yyRelDay
/* day changed */
|| yySeconds + yyRelSeconds > SECONDS_PER_DAY
|| yySeconds + yyRelSeconds < 0
)
) {
if (ClockCalcRelTime(info, &opts) != TCL_OK) {
goto done;
}
}
/* process increment by offset + unit */
yyHaveRel++;
switch (unitIndex) {
case CLC_ADD_YEARS:
yyRelMonth += offs * 12;
break;
case CLC_ADD_MONTHS:
yyRelMonth += offs;
break;
case CLC_ADD_WEEK:
case CLC_ADD_WEEKS:
yyRelDay += offs * 7;
break;
case CLC_ADD_DAYS:
yyRelDay += offs;
break;
case CLC_ADD_WEEKDAYS:
/* add number of week days (skipping Saturdays and Sundays)
* to a relative days value. */
offs = ClockWeekdaysOffs(yy.date.dayOfWeek, offs);
yyRelDay += offs;
break;
case CLC_ADD_HOURS:
yyRelSeconds += offs * 60 * 60;
break;
case CLC_ADD_MINUTES:
yyRelSeconds += offs * 60;
break;
case CLC_ADD_SECONDS:
yyRelSeconds += offs;
break;
}
}
/*
* Do relative times (if not yet already processed interim):
*/
if (yyHaveRel) {
if (ClockCalcRelTime(info, &opts) != TCL_OK) {
goto done;
}
}
/* Convert date info structure into UTC seconds */
ret = ClockScanCommit(clientData, &yy, &opts);
done:
Tcl_UnsetObjRef(yy.date.tzName);
if (ret != TCL_OK) {
return ret;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yy.date.seconds));
return TCL_OK;
}
/*----------------------------------------------------------------------
*
* ClockSecondsObjCmd -
*
* Returns a count of microseconds since the epoch.
|
| ︙ | ︙ | |||
1999 2000 2001 2002 2003 2004 2005 |
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter values */
{
Tcl_Time now;
if (objc != 1) {
| | | | | | | > > > > > | > > > > > > > > > > > > > > > > | > > > | > | < < | < < < < < < < < < < < | < < < | < < < < < < < | 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 |
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter values */
{
Tcl_Time now;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 0, NULL, "clock seconds");
return TCL_ERROR;
}
Tcl_GetTime(&now);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TzsetGetEpoch --, TzsetIfNecessary --
*
* Calls the tzset() library function if the contents of the TZ
* environment variable has changed.
*
* Results:
* None.
*
* Side effects:
* Calls tzset.
*
*----------------------------------------------------------------------
*/
static unsigned long
TzsetGetEpoch(void)
{
static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by
* clockMutex. */
static long tzLastRefresh = 0; /* Used for latency before next refresh */
static size_t tzWasEpoch = 0; /* Epoch, signals that TZ changed */
static size_t tzEnvEpoch = 0; /* Last env epoch, for faster signaling,
that TZ changed via TCL */
const char *tzIsNow; /* Current value of TZ */
/*
* Prevent performance regression on some platforms by resolving of system time zone:
* small latency for check whether environment was changed (once per second)
* no latency if environment was chaned with tcl-env (compare both epoch values)
*/
Tcl_Time now;
Tcl_GetTime(&now);
if (now.sec == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) {
return tzWasEpoch;
}
tzEnvEpoch = TclEnvEpoch;
tzLastRefresh = now.sec;
/* check in lock */
Tcl_MutexLock(&clockMutex);
tzIsNow = getenv("TCL_TZ");
if (tzIsNow == NULL) {
tzIsNow = getenv("TZ");
}
if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
|| strcmp(tzIsNow, tzWas) != 0)) {
tzset();
if (tzWas != NULL && tzWas != INT2PTR(-1)) {
ckfree(tzWas);
}
tzWas = ckalloc(strlen(tzIsNow) + 1);
strcpy(tzWas, tzIsNow);
tzWasEpoch++;
} else if (tzIsNow == NULL && tzWas != NULL) {
tzset();
if (tzWas != INT2PTR(-1)) ckfree(tzWas);
tzWas = NULL;
tzWasEpoch++;
}
Tcl_MutexUnlock(&clockMutex);
return tzWasEpoch;
}
static void
TzsetIfNecessary(void)
{
TzsetGetEpoch();
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Added generic/tclClockFmt.c.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 |
/*
* tclClockFmt.c --
*
* Contains the date format (and scan) routines. This code is back-ported
* from the time and date facilities of tclSE engine, by Serg G. Brester.
*
* Copyright (c) 2015 by Sergey G. Brester aka sebres. All rights reserved.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
#include "tclStrIdxTree.h"
#include "tclDate.h"
/*
* Miscellaneous forward declarations and functions used within this file
*/
static void
ClockFmtObj_DupInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void
ClockFmtObj_FreeInternalRep(Tcl_Obj *objPtr);
static int
ClockFmtObj_SetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void
ClockFmtObj_UpdateString(Tcl_Obj *objPtr);
TCL_DECLARE_MUTEX(ClockFmtMutex); /* Serializes access to common format list. */
static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss);
static void ClockFrmScnFinalize(ClientData clientData);
/*
* Clock scan and format facilities.
*/
/*
*----------------------------------------------------------------------
*
* _str2int -- , _str2wideInt --
*
* Fast inline-convertion of string to signed int or wide int by given
* start/end.
*
* The given string should contain numbers chars only (because already
* pre-validated within parsing routines)
*
* Results:
* Returns a standard Tcl result.
* TCL_OK - by successful conversion, TCL_ERROR by (wide) int overflow
*
*----------------------------------------------------------------------
*/
static inline int
_str2int(
int *out,
register
const char *p,
const char *e,
int sign)
{
register int val = 0, prev = 0;
if (sign >= 0) {
while (p < e) {
val = val * 10 + (*p++ - '0');
if (val < prev) {
return TCL_ERROR;
}
prev = val;
}
} else {
while (p < e) {
val = val * 10 - (*p++ - '0');
if (val > prev) {
return TCL_ERROR;
}
prev = val;
}
}
*out = val;
return TCL_OK;
}
static inline int
_str2wideInt(
Tcl_WideInt *out,
register
const char *p,
const char *e,
int sign)
{
register Tcl_WideInt val = 0, prev = 0;
if (sign >= 0) {
while (p < e) {
val = val * 10 + (*p++ - '0');
if (val < prev) {
return TCL_ERROR;
}
prev = val;
}
} else {
while (p < e) {
val = val * 10 - (*p++ - '0');
if (val > prev) {
return TCL_ERROR;
}
prev = val;
}
}
*out = val;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* _itoaw -- , _witoaw --
*
* Fast inline-convertion of signed int or wide int to string, using
* given padding with specified padchar and width (or without padding).
*
* This is a very fast replacement for sprintf("%02d").
*
* Results:
* Returns position in buffer after end of conversion result.
*
*----------------------------------------------------------------------
*/
static inline char *
_itoaw(
char *buf,
register int val,
char padchar,
unsigned short int width)
{
register char *p;
static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000};
/* positive integer */
if (val >= 0)
{
/* check resp. recalculate width */
while (width <= 9 && val >= wrange[width]) {
width++;
}
/* number to string backwards */
p = buf + width;
*p-- = '\0';
do {
register char c = (val % 10); val /= 10;
*p-- = '0' + c;
} while (val > 0);
/* fulling with pad-char */
while (p >= buf) {
*p-- = padchar;
}
return buf + width;
}
/* negative integer */
if (!width) width++;
/* check resp. recalculate width (regarding sign) */
width--;
while (width <= 9 && val <= -wrange[width]) {
width++;
}
width++;
/* number to string backwards */
p = buf + width;
*p-- = '\0';
/* differentiate platforms with -1 % 10 == 1 and -1 % 10 == -1 */
if (-1 % 10 == -1) {
do {
register char c = (val % 10); val /= 10;
*p-- = '0' - c;
} while (val < 0);
} else {
do {
register char c = (val % 10); val /= 10;
*p-- = '0' + c;
} while (val < 0);
}
/* sign by 0 padding */
if (padchar != '0') { *p-- = '-'; }
/* fulling with pad-char */
while (p >= buf + 1) {
*p-- = padchar;
}
/* sign by non 0 padding */
if (padchar == '0') { *p = '-'; }
return buf + width;
}
static inline char *
_witoaw(
char *buf,
register Tcl_WideInt val,
char padchar,
unsigned short int width)
{
register char *p;
static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000};
/* positive integer */
if (val >= 0)
{
/* check resp. recalculate width */
if (val >= 10000000000L) {
Tcl_WideInt val2;
val2 = val / 10000000000L;
while (width <= 9 && val2 >= wrange[width]) {
width++;
}
width += 10;
} else {
while (width <= 9 && val >= wrange[width]) {
width++;
}
}
/* number to string backwards */
p = buf + width;
*p-- = '\0';
do {
register char c = (val % 10); val /= 10;
*p-- = '0' + c;
} while (val > 0);
/* fulling with pad-char */
while (p >= buf) {
*p-- = padchar;
}
return buf + width;
}
/* negative integer */
if (!width) width++;
/* check resp. recalculate width (regarding sign) */
width--;
if (val <= 10000000000L) {
Tcl_WideInt val2;
val2 = val / 10000000000L;
while (width <= 9 && val2 <= -wrange[width]) {
width++;
}
width += 10;
} else {
while (width <= 9 && val <= -wrange[width]) {
width++;
}
}
width++;
/* number to string backwards */
p = buf + width;
*p-- = '\0';
/* differentiate platforms with -1 % 10 == 1 and -1 % 10 == -1 */
if (-1 % 10 == -1) {
do {
register char c = (val % 10); val /= 10;
*p-- = '0' - c;
} while (val < 0);
} else {
do {
register char c = (val % 10); val /= 10;
*p-- = '0' + c;
} while (val < 0);
}
/* sign by 0 padding */
if (padchar != '0') { *p-- = '-'; }
/* fulling with pad-char */
while (p >= buf + 1) {
*p-- = padchar;
}
/* sign by non 0 padding */
if (padchar == '0') { *p = '-'; }
return buf + width;
}
/*
* Global GC as LIFO for released scan/format object storages.
*
* Used to holds last released CLOCK_FMT_SCN_STORAGE_GC_SIZE formats
* (after last reference from Tcl-object will be removed). This is helpful
* to avoid continuous (re)creation and compiling by some dynamically resp.
* variable format objects, that could be often reused.
*
* As long as format storage is used resp. belongs to GC, it takes place in
* FmtScnHashTable also.
*/
#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
static struct {
ClockFmtScnStorage *stackPtr;
ClockFmtScnStorage *stackBound;
unsigned int count;
} ClockFmtScnStorage_GC = {NULL, NULL, 0};
/*
*----------------------------------------------------------------------
*
* ClockFmtScnStorageGC_In --
*
* Adds an format storage object to GC.
*
* If current GC is full (size larger as CLOCK_FMT_SCN_STORAGE_GC_SIZE)
* this removes last unused storage at begin of GC stack (LIFO).
*
* Assumes caller holds the ClockFmtMutex.
*
* Results:
* None.
*
*----------------------------------------------------------------------
*/
static inline void
ClockFmtScnStorageGC_In(ClockFmtScnStorage *entry)
{
/* add new entry */
TclSpliceIn(entry, ClockFmtScnStorage_GC.stackPtr);
if (ClockFmtScnStorage_GC.stackBound == NULL) {
ClockFmtScnStorage_GC.stackBound = entry;
}
ClockFmtScnStorage_GC.count++;
/* if GC ist full */
if (ClockFmtScnStorage_GC.count > CLOCK_FMT_SCN_STORAGE_GC_SIZE) {
/* GC stack is LIFO: delete first inserted entry */
ClockFmtScnStorage *delEnt = ClockFmtScnStorage_GC.stackBound;
ClockFmtScnStorage_GC.stackBound = delEnt->prevPtr;
TclSpliceOut(delEnt, ClockFmtScnStorage_GC.stackPtr);
ClockFmtScnStorage_GC.count--;
delEnt->prevPtr = delEnt->nextPtr = NULL;
/* remove it now */
ClockFmtScnStorageDelete(delEnt);
}
}
/*
*----------------------------------------------------------------------
*
* ClockFmtScnStorage_GC_Out --
*
* Restores (for reusing) given format storage object from GC.
*
* Assumes caller holds the ClockFmtMutex.
*
* Results:
* None.
*
*----------------------------------------------------------------------
*/
static inline void
ClockFmtScnStorage_GC_Out(ClockFmtScnStorage *entry)
{
TclSpliceOut(entry, ClockFmtScnStorage_GC.stackPtr);
ClockFmtScnStorage_GC.count--;
if (ClockFmtScnStorage_GC.stackBound == entry) {
ClockFmtScnStorage_GC.stackBound = entry->prevPtr;
}
entry->prevPtr = entry->nextPtr = NULL;
}
#endif
/*
* Global format storage hash table of type ClockFmtScnStorageHashKeyType
* (contains list of scan/format object storages, shared across all threads).
*
* Used for fast searching by format string.
*/
static Tcl_HashTable FmtScnHashTable;
static int initialized = 0;
/*
* Wrappers between pointers to hash entry and format storage object
*/
static inline Tcl_HashEntry *
HashEntry4FmtScn(ClockFmtScnStorage *fss) {
return (Tcl_HashEntry*)(fss + 1);
};
static inline ClockFmtScnStorage *
FmtScn4HashEntry(Tcl_HashEntry *hKeyPtr) {
return (ClockFmtScnStorage*)(((char*)hKeyPtr) - sizeof(ClockFmtScnStorage));
};
/*
*----------------------------------------------------------------------
*
* ClockFmtScnStorageAllocProc --
*
* Allocate space for a hash entry containing format storage together
* with the string key.
*
* Results:
* The return value is a pointer to the created entry.
*
*----------------------------------------------------------------------
*/
static Tcl_HashEntry *
ClockFmtScnStorageAllocProc(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key to store in the hash table entry. */
{
ClockFmtScnStorage *fss;
const char *string = (const char *) keyPtr;
Tcl_HashEntry *hPtr;
unsigned int size,
allocsize = sizeof(ClockFmtScnStorage) + sizeof(Tcl_HashEntry);
allocsize += (size = strlen(string) + 1);
if (size > sizeof(hPtr->key)) {
allocsize -= sizeof(hPtr->key);
}
fss = ckalloc(allocsize);
/* initialize */
memset(fss, 0, sizeof(*fss));
hPtr = HashEntry4FmtScn(fss);
memcpy(&hPtr->key.string, string, size);
hPtr->clientData = 0; /* currently unused */
return hPtr;
}
/*
*----------------------------------------------------------------------
*
* ClockFmtScnStorageFreeProc --
*
* Free format storage object and space of given hash entry.
*
* Results:
* None.
*
*----------------------------------------------------------------------
*/
static void
ClockFmtScnStorageFreeProc(
Tcl_HashEntry *hPtr)
{
ClockFmtScnStorage *fss = FmtScn4HashEntry(hPtr);
if (fss->scnTok != NULL) {
ckfree(fss->scnTok);
fss->scnTok = NULL;
fss->scnTokC = 0;
}
if (fss->fmtTok != NULL) {
ckfree(fss->fmtTok);
fss->fmtTok = NULL;
fss->fmtTokC = 0;
}
ckfree(fss);
}
/*
*----------------------------------------------------------------------
*
* ClockFmtScnStorageDelete --
*
* Delete format storage object.
*
* Results:
* None.
*
*----------------------------------------------------------------------
*/
static void
ClockFmtScnStorageDelete(ClockFmtScnStorage *fss) {
Tcl_HashEntry *hPtr = HashEntry4FmtScn(fss);
/*
* This will delete a hash entry and call "ckfree" for storage self, if
* some additionally handling required, freeEntryProc can be used instead
*/
Tcl_DeleteHashEntry(hPtr);
}
/*
* Derivation of tclStringHashKeyType with another allocEntryProc
*/
static Tcl_HashKeyType ClockFmtScnStorageHashKeyType;
/*
* Type definition of clock-format tcl object type.
*/
Tcl_ObjType ClockFmtObjType = {
"clock-format", /* name */
ClockFmtObj_FreeInternalRep, /* freeIntRepProc */
ClockFmtObj_DupInternalRep, /* dupIntRepProc */
ClockFmtObj_UpdateString, /* updateStringProc */
ClockFmtObj_SetFromAny /* setFromAnyProc */
};
#define ObjClockFmtScn(objPtr) \
(*((ClockFmtScnStorage **)&(objPtr)->internalRep.twoPtrValue.ptr1))
#define ObjLocFmtKey(objPtr) \
(*((Tcl_Obj **)&(objPtr)->internalRep.twoPtrValue.ptr2))
static void
ClockFmtObj_DupInternalRep(srcPtr, copyPtr)
Tcl_Obj *srcPtr;
Tcl_Obj *copyPtr;
{
ClockFmtScnStorage *fss = ObjClockFmtScn(srcPtr);
if (fss != NULL) {
Tcl_MutexLock(&ClockFmtMutex);
fss->objRefCount++;
Tcl_MutexUnlock(&ClockFmtMutex);
}
ObjClockFmtScn(copyPtr) = fss;
/* regards special case - format not localizable */
if (ObjLocFmtKey(srcPtr) != srcPtr) {
Tcl_InitObjRef(ObjLocFmtKey(copyPtr), ObjLocFmtKey(srcPtr));
} else {
ObjLocFmtKey(copyPtr) = copyPtr;
}
copyPtr->typePtr = &ClockFmtObjType;
/* if no format representation, dup string representation */
if (fss == NULL) {
copyPtr->bytes = ckalloc(srcPtr->length + 1);
memcpy(copyPtr->bytes, srcPtr->bytes, srcPtr->length + 1);
copyPtr->length = srcPtr->length;
}
}
static void
ClockFmtObj_FreeInternalRep(objPtr)
Tcl_Obj *objPtr;
{
ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr);
if (fss != NULL) {
Tcl_MutexLock(&ClockFmtMutex);
/* decrement object reference count of format/scan storage */
if (--fss->objRefCount <= 0) {
#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
/* don't remove it right now (may be reusable), just add to GC */
ClockFmtScnStorageGC_In(fss);
#else
/* remove storage (format representation) */
ClockFmtScnStorageDelete(fss);
#endif
}
Tcl_MutexUnlock(&ClockFmtMutex);
}
ObjClockFmtScn(objPtr) = NULL;
if (ObjLocFmtKey(objPtr) != objPtr) {
Tcl_UnsetObjRef(ObjLocFmtKey(objPtr));
} else {
ObjLocFmtKey(objPtr) = NULL;
}
objPtr->typePtr = NULL;
};
static int
ClockFmtObj_SetFromAny(interp, objPtr)
Tcl_Interp *interp;
Tcl_Obj *objPtr;
{
/* validate string representation before free old internal represenation */
(void)TclGetString(objPtr);
/* free old internal represenation */
if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc)
objPtr->typePtr->freeIntRepProc(objPtr);
/* initial state of format object */
ObjClockFmtScn(objPtr) = NULL;
ObjLocFmtKey(objPtr) = NULL;
objPtr->typePtr = &ClockFmtObjType;
return TCL_OK;
};
static void
ClockFmtObj_UpdateString(objPtr)
Tcl_Obj *objPtr;
{
const char *name = "UNKNOWN";
int len;
ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr);
if (fss != NULL) {
Tcl_HashEntry *hPtr = HashEntry4FmtScn(fss);
name = hPtr->key.string;
}
len = strlen(name);
objPtr->length = len,
objPtr->bytes = ckalloc((size_t)++len);
if (objPtr->bytes)
memcpy(objPtr->bytes, name, len);
}
/*
*----------------------------------------------------------------------
*
* ClockFrmObjGetLocFmtKey --
*
* Retrieves format key object used to search localized format.
*
* This is normally stored in second pointer of internal representation.
* If format object is not localizable, it is equal the given format
* pointer (special case to fast fallback by not-localizable formats).
*
* Results:
* Returns tcl object with key or format object if not localizable.
*
* Side effects:
* Converts given format object to ClockFmtObjType on demand for caching
* the key inside its internal representation.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE Tcl_Obj*
ClockFrmObjGetLocFmtKey(
Tcl_Interp *interp,
Tcl_Obj *objPtr)
{
Tcl_Obj *keyObj;
if (objPtr->typePtr != &ClockFmtObjType) {
if (ClockFmtObj_SetFromAny(interp, objPtr) != TCL_OK) {
return NULL;
}
}
keyObj = ObjLocFmtKey(objPtr);
if (keyObj) {
return keyObj;
}
keyObj = Tcl_ObjPrintf("FMT_%s", TclGetString(objPtr));
Tcl_InitObjRef(ObjLocFmtKey(objPtr), keyObj);
return keyObj;
}
/*
*----------------------------------------------------------------------
*
* FindOrCreateFmtScnStorage --
*
* Retrieves format storage for given string format.
*
* This will find the given format in the global storage hash table
* or create a format storage object on demaind and save the
* reference in the first pointer of internal representation of given
* object.
*
* Results:
* Returns scan/format storage pointer to ClockFmtScnStorage.
*
* Side effects:
* Converts given format object to ClockFmtObjType on demand for caching
* the format storage reference inside its internal representation.
* Increments objRefCount of the ClockFmtScnStorage reference.
*
*----------------------------------------------------------------------
*/
static ClockFmtScnStorage *
FindOrCreateFmtScnStorage(
Tcl_Interp *interp,
Tcl_Obj *objPtr)
{
const char *strFmt = TclGetString(objPtr);
ClockFmtScnStorage *fss = NULL;
int new;
Tcl_HashEntry *hPtr;
Tcl_MutexLock(&ClockFmtMutex);
/* if not yet initialized */
if (!initialized) {
/* initialize type */
memcpy(&ClockFmtScnStorageHashKeyType, &tclStringHashKeyType, sizeof(tclStringHashKeyType));
ClockFmtScnStorageHashKeyType.allocEntryProc = ClockFmtScnStorageAllocProc;
ClockFmtScnStorageHashKeyType.freeEntryProc = ClockFmtScnStorageFreeProc;
/* initialize hash table */
Tcl_InitCustomHashTable(&FmtScnHashTable, TCL_CUSTOM_TYPE_KEYS,
&ClockFmtScnStorageHashKeyType);
initialized = 1;
Tcl_CreateExitHandler(ClockFrmScnFinalize, NULL);
}
/* get or create entry (and alocate storage) */
hPtr = Tcl_CreateHashEntry(&FmtScnHashTable, strFmt, &new);
if (hPtr != NULL) {
fss = FmtScn4HashEntry(hPtr);
#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
/* unlink if it is currently in GC */
if (new == 0 && fss->objRefCount == 0) {
ClockFmtScnStorage_GC_Out(fss);
}
#endif
/* new reference, so increment in lock right now */
fss->objRefCount++;
ObjClockFmtScn(objPtr) = fss;
}
Tcl_MutexUnlock(&ClockFmtMutex);
if (fss == NULL && interp != NULL) {
Tcl_AppendResult(interp, "retrieve clock format failed \"",
strFmt ? strFmt : "", "\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "EINVAL", NULL);
}
return fss;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetClockFrmScnFromObj --
*
* Returns a clock format/scan representation of (*objPtr), if possible.
* If something goes wrong, NULL is returned, and if interp is non-NULL,
* an error message is written there.
*
* Results:
* Valid representation of type ClockFmtScnStorage.
*
* Side effects:
* Caches the ClockFmtScnStorage reference as the internal rep of (*objPtr)
* and in global hash table, shared across all threads.
*
*----------------------------------------------------------------------
*/
ClockFmtScnStorage *
Tcl_GetClockFrmScnFromObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr)
{
ClockFmtScnStorage *fss;
if (objPtr->typePtr != &ClockFmtObjType) {
if (ClockFmtObj_SetFromAny(interp, objPtr) != TCL_OK) {
return NULL;
}
}
fss = ObjClockFmtScn(objPtr);
if (fss == NULL) {
fss = FindOrCreateFmtScnStorage(interp, objPtr);
}
return fss;
}
/*
*----------------------------------------------------------------------
*
* ClockLocalizeFormat --
*
* Wrap the format object in options to the localized format,
* corresponding given locale.
*
* This searches localized format in locale catalog, and if not yet
* exists, it executes ::tcl::clock::LocalizeFormat in given interpreter
* and caches its result in the locale catalog.
*
* Results:
* Localized format object.
*
* Side effects:
* Caches the localized format inside locale catalog.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE Tcl_Obj *
ClockLocalizeFormat(
ClockFmtScnCmdArgs *opts)
{
ClockClientData *dataPtr = opts->clientData;
Tcl_Obj *valObj = NULL, *keyObj;
keyObj = ClockFrmObjGetLocFmtKey(opts->interp, opts->formatObj);
/* special case - format object is not localizable */
if (keyObj == opts->formatObj) {
return opts->formatObj;
}
/* prevents loss of key object if the format object (where key stored)
* becomes changed (loses its internal representation during evals) */
Tcl_IncrRefCount(keyObj);
if (opts->mcDictObj == NULL) {
ClockMCDict(opts);
if (opts->mcDictObj == NULL)
goto done;
}
/* try to find in cache within locale mc-catalog */
if (Tcl_DictObjGet(NULL, opts->mcDictObj,
keyObj, &valObj) != TCL_OK) {
goto done;
}
/* call LocalizeFormat locale format fmtkey */
if (valObj == NULL) {
Tcl_Obj *callargs[4];
callargs[0] = dataPtr->literals[LIT_LOCALIZE_FORMAT];
callargs[1] = opts->localeObj;
callargs[2] = opts->formatObj;
callargs[3] = keyObj;
if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK
) {
goto done;
}
valObj = Tcl_GetObjResult(opts->interp);
/* cache it inside mc-dictionary (this incr. ref count of keyObj/valObj) */
if (Tcl_DictObjPut(opts->interp, opts->mcDictObj,
keyObj, valObj) != TCL_OK
) {
valObj = NULL;
goto done;
}
Tcl_ResetResult(opts->interp);
/* check special case - format object is not localizable */
if (valObj == opts->formatObj) {
/* mark it as unlocalizable, by setting self as key (without refcount incr) */
if (opts->formatObj->typePtr == &ClockFmtObjType) {
Tcl_UnsetObjRef(ObjLocFmtKey(opts->formatObj));
ObjLocFmtKey(opts->formatObj) = opts->formatObj;
}
}
}
done:
Tcl_UnsetObjRef(keyObj);
return (opts->formatObj = valObj);
}
/*
*----------------------------------------------------------------------
*
* FindTokenBegin --
*
* Find begin of given scan token in string, corresponding token type.
*
* Results:
* Position of token inside string if found. Otherwise - end of string.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static const char *
FindTokenBegin(
register const char *p,
register const char *end,
ClockScanToken *tok)
{
char c;
if (p < end) {
/* next token a known token type */
switch (tok->map->type) {
case CTOKT_DIGIT:
/* should match at least one digit */
while (!isdigit(UCHAR(*p)) && (p = TclUtfNext(p)) < end) {};
return p;
break;
case CTOKT_WORD:
c = *(tok->tokWord.start);
/* should match at least to the first char of this word */
while (*p != c && (p = TclUtfNext(p)) < end) {};
return p;
break;
case CTOKT_SPACE:
while (!isspace(UCHAR(*p)) && (p = TclUtfNext(p)) < end) {};
return p;
break;
case CTOKT_CHAR:
c = *((char *)tok->map->data);
while (*p != c && (p = TclUtfNext(p)) < end) {};
return p;
break;
}
}
return p;
}
/*
*----------------------------------------------------------------------
*
* DetermineGreedySearchLen --
*
* Determine min/max lengths as exact as possible (speed, greedy match).
*
* Results:
* None. Lengths are stored in *minLenPtr, *maxLenPtr.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static void
DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts,
DateInfo *info, ClockScanToken *tok,
int *minLenPtr, int *maxLenPtr)
{
register int minLen = tok->map->minSize;
register int maxLen;
register const char *p = yyInput + minLen,
*end = info->dateEnd;
/* if still tokens available, try to correct minimum length */
if ((tok+1)->map) {
end -= tok->endDistance + yySpaceCount;
/* find position of next known token */
p = FindTokenBegin(p, end, tok+1);
if (p < end) {
minLen = p - yyInput;
}
}
/* max length to the end regarding distance to end (min-width of following tokens) */
maxLen = end - yyInput;
/* several amendments */
if (maxLen > tok->map->maxSize) {
maxLen = tok->map->maxSize;
};
if (minLen < tok->map->minSize) {
minLen = tok->map->minSize;
}
if (minLen > maxLen) {
maxLen = minLen;
}
if (maxLen > info->dateEnd - yyInput) {
maxLen = info->dateEnd - yyInput;
}
/* check digits rigth now */
if (tok->map->type == CTOKT_DIGIT) {
p = yyInput;
end = p + maxLen;
if (end > info->dateEnd) { end = info->dateEnd; };
while (isdigit(UCHAR(*p)) && p < end) { p++; };
maxLen = p - yyInput;
}
/* try to get max length more precise for greedy match,
* check the next ahead token available there */
if (minLen < maxLen && tok->lookAhTok) {
ClockScanToken *laTok = tok + tok->lookAhTok + 1;
p = yyInput + maxLen;
/* regards all possible spaces here (because they are optional) */
end = p + tok->lookAhMax + yySpaceCount + 1;
if (end > info->dateEnd) {
end = info->dateEnd;
}
p += tok->lookAhMin;
if (laTok->map && p < end) {
const char *f;
/* try to find laTok between [lookAhMin, lookAhMax] */
while (minLen < maxLen) {
f = FindTokenBegin(p, end, laTok);
/* if found (not below lookAhMax) */
if (f < end) {
break;
}
/* try again with fewer length */
maxLen--;
p--;
end--;
}
} else if (p > end) {
maxLen -= (p - end);
if (maxLen < minLen) {
maxLen = minLen;
}
}
}
*minLenPtr = minLen;
*maxLenPtr = maxLen;
}
/*
*----------------------------------------------------------------------
*
* ObjListSearch --
*
* Find largest part of the input string from start regarding min and
* max lengths in the given list (utf-8, case sensitive).
*
* Results:
* TCL_OK - match found, TCL_RETURN - not matched, TCL_ERROR in error case.
*
* Side effects:
* Input points to end of the found token in string.
*
*----------------------------------------------------------------------
*/
static inline int
ObjListSearch(ClockFmtScnCmdArgs *opts,
DateInfo *info, int *val,
Tcl_Obj **lstv, int lstc,
int minLen, int maxLen)
{
int i, l, lf = -1;
const char *s, *f, *sf;
/* search in list */
for (i = 0; i < lstc; i++) {
s = TclGetString(lstv[i]);
l = lstv[i]->length;
if ( l >= minLen
&& (f = TclUtfFindEqualNC(yyInput, yyInput + maxLen, s, s + l, &sf)) > yyInput
) {
l = f - yyInput;
if (l < minLen) {
continue;
}
/* found, try to find longest value (greedy search) */
if (l < maxLen && minLen != maxLen) {
lf = i;
minLen = l + 1;
continue;
}
/* max possible - end of search */
*val = i;
yyInput += l;
break;
}
}
/* if found */
if (i < lstc) {
return TCL_OK;
}
if (lf >= 0) {
*val = lf;
yyInput += minLen - 1;
return TCL_OK;
}
return TCL_RETURN;
}
#if 0
/* currently unused */
static int
LocaleListSearch(ClockFmtScnCmdArgs *opts,
DateInfo *info, int mcKey, int *val,
int minLen, int maxLen)
{
Tcl_Obj **lstv;
int lstc;
Tcl_Obj *valObj;
/* get msgcat value */
valObj = ClockMCGet(opts, mcKey);
if (valObj == NULL) {
return TCL_ERROR;
}
/* is a list */
if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) {
return TCL_ERROR;
}
/* search in list */
return ObjListSearch(opts, info, val, lstv, lstc,
minLen, maxLen);
}
#endif
/*
*----------------------------------------------------------------------
*
* ClockMCGetListIdxTree --
*
* Retrieves localized string indexed tree in the locale catalog for
* given literal index mcKey (and builds it on demand).
*
* Searches localized index in locale catalog, and if not yet exists,
* creates string indexed tree and stores it in the locale catalog.
*
* Results:
* Localized string index tree.
*
* Side effects:
* Caches the localized string index tree inside locale catalog.
*
*----------------------------------------------------------------------
*/
static TclStrIdxTree *
ClockMCGetListIdxTree(
ClockFmtScnCmdArgs *opts,
int mcKey)
{
TclStrIdxTree * idxTree;
Tcl_Obj *objPtr = ClockMCGetIdx(opts, mcKey);
if ( objPtr != NULL
&& (idxTree = TclStrIdxTreeGetFromObj(objPtr)) != NULL
) {
return idxTree;
} else {
/* build new index */
Tcl_Obj **lstv;
int lstc;
Tcl_Obj *valObj;
objPtr = TclStrIdxTreeNewObj();
if ((idxTree = TclStrIdxTreeGetFromObj(objPtr)) == NULL) {
goto done; /* unexpected, but ...*/
}
valObj = ClockMCGet(opts, mcKey);
if (valObj == NULL) {
goto done;
}
if (TclListObjGetElements(opts->interp, valObj,
&lstc, &lstv) != TCL_OK) {
goto done;
};
if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv, NULL) != TCL_OK) {
goto done;
}
ClockMCSetIdx(opts, mcKey, objPtr);
objPtr = NULL;
};
done:
if (objPtr) {
Tcl_DecrRefCount(objPtr);
idxTree = NULL;
}
return idxTree;
}
/*
*----------------------------------------------------------------------
*
* ClockMCGetMultiListIdxTree --
*
* Retrieves localized string indexed tree in the locale catalog for
* multiple lists by literal indices mcKeys (and builds it on demand).
*
* Searches localized index in locale catalog for mcKey, and if not
* yet exists, creates string indexed tree and stores it in the
* locale catalog.
*
* Results:
* Localized string index tree.
*
* Side effects:
* Caches the localized string index tree inside locale catalog.
*
*----------------------------------------------------------------------
*/
static TclStrIdxTree *
ClockMCGetMultiListIdxTree(
ClockFmtScnCmdArgs *opts,
int mcKey,
int *mcKeys)
{
TclStrIdxTree * idxTree;
Tcl_Obj *objPtr = ClockMCGetIdx(opts, mcKey);
if ( objPtr != NULL
&& (idxTree = TclStrIdxTreeGetFromObj(objPtr)) != NULL
) {
return idxTree;
} else {
/* build new index */
Tcl_Obj **lstv;
int lstc;
Tcl_Obj *valObj;
objPtr = TclStrIdxTreeNewObj();
if ((idxTree = TclStrIdxTreeGetFromObj(objPtr)) == NULL) {
goto done; /* unexpected, but ...*/
}
while (*mcKeys) {
valObj = ClockMCGet(opts, *mcKeys);
if (valObj == NULL) {
goto done;
}
if (TclListObjGetElements(opts->interp, valObj,
&lstc, &lstv) != TCL_OK) {
goto done;
};
if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv, NULL) != TCL_OK) {
goto done;
}
mcKeys++;
}
ClockMCSetIdx(opts, mcKey, objPtr);
objPtr = NULL;
};
done:
if (objPtr) {
Tcl_DecrRefCount(objPtr);
idxTree = NULL;
}
return idxTree;
}
/*
*----------------------------------------------------------------------
*
* ClockStrIdxTreeSearch --
*
* Find largest part of the input string from start regarding lengths
* in the given localized string indexed tree (utf-8, case sensitive).
*
* Results:
* TCL_OK - match found and the index stored in *val,
* TCL_RETURN - not matched or ambigous,
* TCL_ERROR - in error case.
*
* Side effects:
* Input points to end of the found token in string.
*
*----------------------------------------------------------------------
*/
static inline int
ClockStrIdxTreeSearch(ClockFmtScnCmdArgs *opts,
DateInfo *info, TclStrIdxTree *idxTree, int *val,
int minLen, int maxLen)
{
const char *f;
TclStrIdx *foundItem;
f = TclStrIdxTreeSearch(NULL, &foundItem, idxTree,
yyInput, yyInput + maxLen);
if (f <= yyInput || (f - yyInput) < minLen) {
/* not found */
return TCL_RETURN;
}
if (!foundItem->value) {
/* ambigous */
return TCL_RETURN;
}
*val = PTR2INT(foundItem->value);
/* shift input pointer */
yyInput = f;
return TCL_OK;
}
#if 0
/* currently unused */
static int
StaticListSearch(ClockFmtScnCmdArgs *opts,
DateInfo *info, const char **lst, int *val)
{
int len;
const char **s = lst;
while (*s != NULL) {
len = strlen(*s);
if ( len <= info->dateEnd - yyInput
&& strncasecmp(yyInput, *s, len) == 0
) {
*val = (s - lst);
yyInput += len;
break;
}
s++;
}
if (*s != NULL) {
return TCL_OK;
}
return TCL_RETURN;
}
#endif
static inline const char *
FindWordEnd(
ClockScanToken *tok,
register const char * p, const char * end)
{
register const char *x = tok->tokWord.start;
const char *pfnd = p;
if (x == tok->tokWord.end - 1) { /* fast phase-out for single char word */
if (*p == *x) {
return ++p;
}
}
/* multi-char word */
x = TclUtfFindEqualNC(x, tok->tokWord.end, p, end, &pfnd);
if (x < tok->tokWord.end) {
/* no match -> error */
return NULL;
}
return pfnd;
}
static int
ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts,
DateInfo *info, ClockScanToken *tok)
{
#if 0
/* currently unused, test purposes only */
static const char * months[] = {
/* full */
"January", "February", "March",
"April", "May", "June",
"July", "August", "September",
"October", "November", "December",
/* abbr */
"Jan", "Feb", "Mar", "Apr", "May", "Jun",
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec",
NULL
};
int val;
if (StaticListSearch(opts, info, months, &val) != TCL_OK) {
return TCL_RETURN;
}
yyMonth = (val % 12) + 1;
return TCL_OK;
#endif
static int monthsKeys[] = {MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, 0};
int ret, val;
int minLen, maxLen;
TclStrIdxTree *idxTree;
DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
/* get or create tree in msgcat dict */
idxTree = ClockMCGetMultiListIdxTree(opts, MCLIT_MONTHS_COMB, monthsKeys);
if (idxTree == NULL) {
return TCL_ERROR;
}
ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen);
if (ret != TCL_OK) {
return ret;
}
yyMonth = val;
return TCL_OK;
}
static int
ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts,
DateInfo *info, ClockScanToken *tok)
{
static int dowKeys[] = {MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_FULL, 0};
int ret, val;
int minLen, maxLen;
char curTok = *tok->tokWord.start;
TclStrIdxTree *idxTree;
DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
/* %u %w %Ou %Ow */
if ( curTok != 'a' && curTok != 'A'
&& ((minLen <= 1 && maxLen >= 1) || PTR2INT(tok->map->data))
) {
val = -1;
if (PTR2INT(tok->map->data) == 0) {
if (*yyInput >= '0' && *yyInput <= '9') {
val = *yyInput - '0';
}
} else {
idxTree = ClockMCGetListIdxTree(opts, PTR2INT(tok->map->data) /* mcKey */);
if (idxTree == NULL) {
return TCL_ERROR;
}
ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen);
if (ret != TCL_OK) {
return ret;
}
--val;
}
if (val != -1) {
if (val == 0) {
val = 7;
}
if (val > 7) {
Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("day of week is greater than 7", -1));
Tcl_SetErrorCode(opts->interp, "CLOCK", "badDayOfWeek", NULL);
return TCL_ERROR;
}
info->date.dayOfWeek = val;
yyInput++;
return TCL_OK;
}
return TCL_RETURN;
}
/* %a %A */
idxTree = ClockMCGetMultiListIdxTree(opts, MCLIT_DAYS_OF_WEEK_COMB, dowKeys);
if (idxTree == NULL) {
return TCL_ERROR;
}
ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen);
if (ret != TCL_OK) {
return ret;
}
--val;
if (val == 0) {
val = 7;
}
info->date.dayOfWeek = val;
return TCL_OK;
}
static int
ClockScnToken_amPmInd_Proc(ClockFmtScnCmdArgs *opts,
DateInfo *info, ClockScanToken *tok)
{
int ret, val;
int minLen, maxLen;
Tcl_Obj *amPmObj[2];
DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
amPmObj[0] = ClockMCGet(opts, MCLIT_AM);
amPmObj[1] = ClockMCGet(opts, MCLIT_PM);
if (amPmObj[0] == NULL || amPmObj[1] == NULL) {
return TCL_ERROR;
}
ret = ObjListSearch(opts, info, &val, amPmObj, 2,
minLen, maxLen);
if (ret != TCL_OK) {
return ret;
}
if (val == 0) {
yyMeridian = MERam;
} else {
yyMeridian = MERpm;
}
return TCL_OK;
}
static int
ClockScnToken_LocaleERA_Proc(ClockFmtScnCmdArgs *opts,
DateInfo *info, ClockScanToken *tok)
{
ClockClientData *dataPtr = opts->clientData;
int ret, val;
int minLen, maxLen;
Tcl_Obj *eraObj[6];
DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
eraObj[0] = ClockMCGet(opts, MCLIT_BCE);
eraObj[1] = ClockMCGet(opts, MCLIT_CE);
eraObj[2] = dataPtr->mcLiterals[MCLIT_BCE2];
eraObj[3] = dataPtr->mcLiterals[MCLIT_CE2];
eraObj[4] = dataPtr->mcLiterals[MCLIT_BCE3];
eraObj[5] = dataPtr->mcLiterals[MCLIT_CE3];
if (eraObj[0] == NULL || eraObj[1] == NULL) {
return TCL_ERROR;
}
ret = ObjListSearch(opts, info, &val, eraObj, 6,
minLen, maxLen);
if (ret != TCL_OK) {
return ret;
}
if (val & 1) {
yydate.era = CE;
} else {
yydate.era = BCE;
}
return TCL_OK;
}
static int
ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts,
DateInfo *info, ClockScanToken *tok)
{
int ret, val;
int minLen, maxLen;
TclStrIdxTree *idxTree;
DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
/* get or create tree in msgcat dict */
idxTree = ClockMCGetListIdxTree(opts, PTR2INT(tok->map->data) /* mcKey */);
if (idxTree == NULL) {
return TCL_ERROR;
}
ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen);
if (ret != TCL_OK) {
return ret;
}
if (tok->map->offs > 0) {
*(int *)(((char *)info) + tok->map->offs) = --val;
}
return TCL_OK;
}
static int
ClockScnToken_TimeZone_Proc(ClockFmtScnCmdArgs *opts,
DateInfo *info, ClockScanToken *tok)
{
int minLen, maxLen;
int len = 0;
register const char *p = yyInput;
Tcl_Obj *tzObjStor = NULL;
DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
/* numeric timezone */
if (*p == '+' || *p == '-') {
/* max chars in numeric zone = "+00:00:00" */
#define MAX_ZONE_LEN 9
char buf[MAX_ZONE_LEN + 1];
char *bp = buf;
*bp++ = *p++; len++;
if (maxLen > MAX_ZONE_LEN)
maxLen = MAX_ZONE_LEN;
/* cumulate zone into buf without ':' */
while (len + 1 < maxLen) {
if (!isdigit(UCHAR(*p))) break;
*bp++ = *p++; len++;
if (!isdigit(UCHAR(*p))) break;
*bp++ = *p++; len++;
if (len + 2 < maxLen) {
if (*p == ':') {
p++; len++;
}
}
}
*bp = '\0';
if (len < minLen) {
return TCL_RETURN;
}
#undef MAX_ZONE_LEN
/* timezone */
tzObjStor = Tcl_NewStringObj(buf, bp-buf);
} else {
/* legacy (alnum) timezone like CEST, etc. */
if (maxLen > 4)
maxLen = 4;
while (len < maxLen) {
if ( (*p & 0x80)
|| (!isalpha(UCHAR(*p)) && !isdigit(UCHAR(*p)))
) { /* INTL: ISO only. */
break;
}
p++; len++;
}
if (len < minLen) {
return TCL_RETURN;
}
/* timezone */
tzObjStor = Tcl_NewStringObj(yyInput, p-yyInput);
/* convert using dict */
}
/* try to apply new time zone */
Tcl_IncrRefCount(tzObjStor);
opts->timezoneObj = ClockSetupTimeZone(opts->clientData, opts->interp,
tzObjStor);
Tcl_DecrRefCount(tzObjStor);
if (opts->timezoneObj == NULL) {
return TCL_ERROR;
}
yyInput += len;
return TCL_OK;
}
static int
ClockScnToken_StarDate_Proc(ClockFmtScnCmdArgs *opts,
DateInfo *info, ClockScanToken *tok)
{
int minLen, maxLen;
register const char *p = yyInput, *end; const char *s;
int year, fractYear, fractDayDiv, fractDay;
static const char *stardatePref = "stardate ";
DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
end = yyInput + maxLen;
/* stardate string */
p = TclUtfFindEqualNCInLwr(p, end, stardatePref, stardatePref + 9, &s);
if (p >= end || p - yyInput < 9) {
return TCL_RETURN;
}
/* bypass spaces */
while (p < end && isspace(UCHAR(*p))) {
p++;
}
if (p >= end) {
return TCL_RETURN;
}
/* currently positive stardate only */
if (*p == '+') { p++; };
s = p;
while (p < end && isdigit(UCHAR(*p))) {
p++;
}
if (p >= end || p - s < 4) {
return TCL_RETURN;
}
if ( _str2int(&year, s, p-3, 1) != TCL_OK
|| _str2int(&fractYear, p-3, p, 1) != TCL_OK) {
return TCL_RETURN;
};
if (*p++ != '.') {
return TCL_RETURN;
}
s = p;
fractDayDiv = 1;
while (p < end && isdigit(UCHAR(*p))) {
fractDayDiv *= 10;
p++;
}
if ( _str2int(&fractDay, s, p, 1) != TCL_OK) {
return TCL_RETURN;
};
yyInput = p;
/* Build a date from year and fraction. */
yydate.year = year + RODDENBERRY;
yydate.era = CE;
yydate.gregorian = 1;
if (IsGregorianLeapYear(&yydate)) {
fractYear *= 366;
} else {
fractYear *= 365;
}
yydate.dayOfYear = fractYear / 1000 + 1;
if (fractYear % 1000 >= 500) {
yydate.dayOfYear++;
}
GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
yydate.localSeconds =
-210866803200L
+ ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay )
+ ( SECONDS_PER_DAY * fractDay / fractDayDiv );
return TCL_OK;
}
static const char *ScnSTokenMapIndex =
"dmbyYHMSpJjCgGVazUsntQ";
static ClockScanTokenMap ScnSTokenMap[] = {
/* %d %e */
{CTOKT_DIGIT, CLF_DAYOFMONTH, 0, 1, 2, TclOffset(DateInfo, date.dayOfMonth),
NULL},
/* %m %N */
{CTOKT_DIGIT, CLF_MONTH, 0, 1, 2, TclOffset(DateInfo, date.month),
NULL},
/* %b %B %h */
{CTOKT_PARSER, CLF_MONTH, 0, 0, 0xffff, 0,
ClockScnToken_Month_Proc},
/* %y */
{CTOKT_DIGIT, CLF_YEAR, 0, 1, 2, TclOffset(DateInfo, date.year),
NULL},
/* %Y */
{CTOKT_DIGIT, CLF_YEAR | CLF_CENTURY, 0, 4, 4, TclOffset(DateInfo, date.year),
NULL},
/* %H %k %I %l */
{CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.hour),
NULL},
/* %M */
{CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.minutes),
NULL},
/* %S */
{CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.secondOfDay),
NULL},
/* %p %P */
{CTOKT_PARSER, CLF_ISO8601, 0, 0, 0xffff, 0,
ClockScnToken_amPmInd_Proc, NULL},
/* %J */
{CTOKT_DIGIT, CLF_JULIANDAY, 0, 1, 0xffff, TclOffset(DateInfo, date.julianDay),
NULL},
/* %j */
{CTOKT_DIGIT, CLF_DAYOFYEAR, 0, 1, 3, TclOffset(DateInfo, date.dayOfYear),
NULL},
/* %C */
{CTOKT_DIGIT, CLF_CENTURY|CLF_ISO8601CENTURY, 0, 1, 2, TclOffset(DateInfo, dateCentury),
NULL},
/* %g */
{CTOKT_DIGIT, CLF_ISO8601YEAR | CLF_ISO8601, 0, 2, 2, TclOffset(DateInfo, date.iso8601Year),
NULL},
/* %G */
{CTOKT_DIGIT, CLF_ISO8601YEAR | CLF_ISO8601 | CLF_ISO8601CENTURY, 0, 4, 4, TclOffset(DateInfo, date.iso8601Year),
NULL},
/* %V */
{CTOKT_DIGIT, CLF_ISO8601, 0, 1, 2, TclOffset(DateInfo, date.iso8601Week),
NULL},
/* %a %A %u %w */
{CTOKT_PARSER, CLF_ISO8601, 0, 0, 0xffff, 0,
ClockScnToken_DayOfWeek_Proc, NULL},
/* %z %Z */
{CTOKT_PARSER, CLF_OPTIONAL, 0, 0, 0xffff, 0,
ClockScnToken_TimeZone_Proc, NULL},
/* %U %W */
{CTOKT_DIGIT, CLF_OPTIONAL, 0, 1, 2, 0, /* currently no capture, parse only token */
NULL},
/* %s */
{CTOKT_DIGIT, CLF_POSIXSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.seconds),
NULL},
/* %n */
{CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\n"},
/* %t */
{CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\t"},
/* %Q */
{CTOKT_PARSER, CLF_LOCALSEC, 0, 16, 30, 0,
ClockScnToken_StarDate_Proc, NULL},
};
static const char *ScnSTokenMapAliasIndex[2] = {
"eNBhkIlPAuwZW",
"dmbbHHHpaaazU"
};
static const char *ScnETokenMapIndex =
"Eys";
static ClockScanTokenMap ScnETokenMap[] = {
/* %EE */
{CTOKT_PARSER, 0, 0, 0, 0xffff, TclOffset(DateInfo, date.year),
ClockScnToken_LocaleERA_Proc, (void *)MCLIT_LOCALE_NUMERALS},
/* %Ey */
{CTOKT_PARSER, 0, 0, 0, 0xffff, 0, /* currently no capture, parse only token */
ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
/* %Es */
{CTOKT_DIGIT, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.localSeconds),
NULL},
};
static const char *ScnETokenMapAliasIndex[2] = {
"",
""
};
static const char *ScnOTokenMapIndex =
"dmyHMSu";
static ClockScanTokenMap ScnOTokenMap[] = {
/* %Od %Oe */
{CTOKT_PARSER, CLF_DAYOFMONTH, 0, 0, 0xffff, TclOffset(DateInfo, date.dayOfMonth),
ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
/* %Om */
{CTOKT_PARSER, CLF_MONTH, 0, 0, 0xffff, TclOffset(DateInfo, date.month),
ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
/* %Oy */
{CTOKT_PARSER, CLF_YEAR, 0, 0, 0xffff, TclOffset(DateInfo, date.year),
ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
/* %OH %Ok %OI %Ol */
{CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.hour),
ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
/* %OM */
{CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.minutes),
ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
/* %OS */
{CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.secondOfDay),
ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
/* %Ou Ow */
{CTOKT_PARSER, CLF_ISO8601, 0, 0, 0xffff, 0,
ClockScnToken_DayOfWeek_Proc, (void *)MCLIT_LOCALE_NUMERALS},
};
static const char *ScnOTokenMapAliasIndex[2] = {
"ekIlw",
"dHHHu"
};
static const char *ScnSpecTokenMapIndex =
" ";
static ClockScanTokenMap ScnSpecTokenMap[] = {
{CTOKT_SPACE, 0, 0, 1, 1, 0,
NULL},
};
static ClockScanTokenMap ScnWordTokenMap = {
CTOKT_WORD, 0, 0, 1, 1, 0,
NULL
};
static inline unsigned int
EstimateTokenCount(
register const char *fmt,
register const char *end)
{
register const char *p = fmt;
unsigned int tokcnt;
/* estimate token count by % char and format length */
tokcnt = 0;
while (p <= end) {
if (*p++ == '%') {
tokcnt++;
p++;
}
}
p = fmt + tokcnt * 2;
if (p < end) {
if ((unsigned int)(end - p) < tokcnt) {
tokcnt += (end - p);
} else {
tokcnt += tokcnt;
}
}
return ++tokcnt;
}
#define AllocTokenInChain(tok, chain, tokCnt) \
if (++(tok) >= (chain) + (tokCnt)) { \
chain = ckrealloc((char *)(chain), \
(tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \
if ((chain) == NULL) { goto done; }; \
(tok) = (chain) + (tokCnt); \
(tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \
} \
memset(tok, 0, sizeof(*(tok)));
/*
*----------------------------------------------------------------------
*/
ClockFmtScnStorage *
ClockGetOrParseScanFormat(
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Obj *formatObj) /* Format container */
{
ClockFmtScnStorage *fss;
ClockScanToken *tok;
fss = Tcl_GetClockFrmScnFromObj(interp, formatObj);
if (fss == NULL) {
return NULL;
}
/* if first time scanning - tokenize format */
if (fss->scnTok == NULL) {
unsigned int tokCnt;
register const char *p, *e, *cp;
e = p = HashEntry4FmtScn(fss)->key.string;
e += strlen(p);
/* estimate token count by % char and format length */
fss->scnTokC = EstimateTokenCount(p, e);
fss->scnSpaceCount = 0;
Tcl_MutexLock(&ClockFmtMutex);
fss->scnTok = tok = ckalloc(sizeof(*tok) * fss->scnTokC);
memset(tok, 0, sizeof(*(tok)));
tokCnt = 1;
while (p < e) {
switch (*p) {
case '%':
if (1) {
ClockScanTokenMap * scnMap = ScnSTokenMap;
const char *mapIndex = ScnSTokenMapIndex,
**aliasIndex = ScnSTokenMapAliasIndex;
if (p+1 >= e) {
goto word_tok;
}
p++;
/* try to find modifier: */
switch (*p) {
case '%':
/* begin new word token - don't join with previous word token,
* because current mapping should be "...%%..." -> "...%..." */
tok->map = &ScnWordTokenMap;
tok->tokWord.start = p;
tok->tokWord.end = p+1;
AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++;
p++;
continue;
break;
case 'E':
scnMap = ScnETokenMap,
mapIndex = ScnETokenMapIndex,
aliasIndex = ScnETokenMapAliasIndex;
p++;
break;
case 'O':
scnMap = ScnOTokenMap,
mapIndex = ScnOTokenMapIndex,
aliasIndex = ScnOTokenMapAliasIndex;
p++;
break;
}
/* search direct index */
cp = strchr(mapIndex, *p);
if (!cp || *cp == '\0') {
/* search wrapper index (multiple chars for same token) */
cp = strchr(aliasIndex[0], *p);
if (!cp || *cp == '\0') {
p--; if (scnMap != ScnSTokenMap) p--;
goto word_tok;
}
cp = strchr(mapIndex, aliasIndex[1][cp - aliasIndex[0]]);
if (!cp || *cp == '\0') { /* unexpected, but ... */
#ifdef DEBUG
Tcl_Panic("token \"%c\" has no map in wrapper resolver", *p);
#endif
p--; if (scnMap != ScnSTokenMap) p--;
goto word_tok;
}
}
tok->map = &scnMap[cp - mapIndex];
tok->tokWord.start = p;
/* calculate look ahead value by standing together tokens */
if (tok > fss->scnTok) {
ClockScanToken *prevTok = tok - 1;
while (prevTok >= fss->scnTok) {
if (prevTok->map->type != tok->map->type) {
break;
}
prevTok->lookAhMin += tok->map->minSize;
prevTok->lookAhMax += tok->map->maxSize;
prevTok->lookAhTok++;
prevTok--;
}
}
/* increase space count used in format */
if ( tok->map->type == CTOKT_CHAR
&& isspace(UCHAR(*((char *)tok->map->data)))
) {
fss->scnSpaceCount++;
}
/* next token */
AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++;
p++;
continue;
}
break;
case ' ':
cp = strchr(ScnSpecTokenMapIndex, *p);
if (!cp || *cp == '\0') {
p--;
goto word_tok;
}
tok->map = &ScnSpecTokenMap[cp - ScnSpecTokenMapIndex];
/* increase space count used in format */
fss->scnSpaceCount++;
/* next token */
AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++;
p++;
continue;
break;
default:
word_tok:
if (1) {
ClockScanToken *wordTok = tok;
if (tok > fss->scnTok && (tok-1)->map == &ScnWordTokenMap) {
wordTok = tok-1;
}
/* new word token */
if (wordTok == tok) {
wordTok->tokWord.start = p;
wordTok->map = &ScnWordTokenMap;
AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++;
}
if (isspace(UCHAR(*p))) {
fss->scnSpaceCount++;
}
p = TclUtfNext(p);
wordTok->tokWord.end = p;
}
break;
}
}
/* calculate end distance value for each tokens */
if (tok > fss->scnTok) {
unsigned int endDist = 0;
ClockScanToken *prevTok = tok-1;
while (prevTok >= fss->scnTok) {
prevTok->endDistance = endDist;
if (prevTok->map->type != CTOKT_WORD) {
endDist += prevTok->map->minSize;
} else {
endDist += prevTok->tokWord.end - prevTok->tokWord.start;
}
prevTok--;
}
}
/* correct count of real used tokens and free mem if desired
* (1 is acceptable delta to prevent memory fragmentation) */
if (fss->scnTokC > tokCnt + (CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE / 2)) {
if ( (tok = ckrealloc(fss->scnTok, tokCnt * sizeof(*tok))) != NULL ) {
fss->scnTok = tok;
}
}
fss->scnTokC = tokCnt;
done:
Tcl_MutexUnlock(&ClockFmtMutex);
}
return fss;
}
/*
*----------------------------------------------------------------------
*/
int
ClockScan(
register DateInfo *info, /* Date fields used for parsing & converting */
Tcl_Obj *strObj, /* String containing the time to scan */
ClockFmtScnCmdArgs *opts) /* Command options */
{
ClockClientData *dataPtr = opts->clientData;
ClockFmtScnStorage *fss;
ClockScanToken *tok;
ClockScanTokenMap *map;
register const char *p, *x, *end;
unsigned short int flags = 0;
int ret = TCL_ERROR;
/* get localized format */
if (ClockLocalizeFormat(opts) == NULL) {
return TCL_ERROR;
}
if ( !(fss = ClockGetOrParseScanFormat(opts->interp, opts->formatObj))
|| !(tok = fss->scnTok)
) {
return TCL_ERROR;
}
/* prepare parsing */
yyMeridian = MER24;
p = TclGetString(strObj);
end = p + strObj->length;
/* in strict mode - bypass spaces at begin / end only (not between tokens) */
if (opts->flags & CLF_STRICT) {
while (p < end && isspace(UCHAR(*p))) {
p++;
}
}
yyInput = p;
/* look ahead to count spaces (bypass it by count length and distances) */
x = end;
while (p < end) {
if (isspace(UCHAR(*p))) {
x = p++;
yySpaceCount++;
continue;
}
x = end;
p++;
}
/* ignore spaces at end */
yySpaceCount -= (end - x);
end = x;
/* ignore mandatory spaces used in format */
yySpaceCount -= fss->scnSpaceCount;
if (yySpaceCount < 0) {
yySpaceCount = 0;
}
info->dateStart = p = yyInput;
info->dateEnd = end;
/* parse string */
for (; tok->map != NULL; tok++) {
map = tok->map;
/* bypass spaces at begin of input before parsing each token */
if ( !(opts->flags & CLF_STRICT)
&& ( map->type != CTOKT_SPACE
&& map->type != CTOKT_WORD
&& map->type != CTOKT_CHAR )
) {
while (p < end && isspace(UCHAR(*p))) {
yySpaceCount--;
p++;
}
}
yyInput = p;
/* end of input string */
if (p >= end) {
break;
}
switch (map->type)
{
case CTOKT_DIGIT:
if (1) {
int minLen, size;
int sign = 1;
if (map->flags & CLF_SIGNED) {
if (*p == '+') { yyInput = ++p; }
else
if (*p == '-') { yyInput = ++p; sign = -1; };
}
DetermineGreedySearchLen(opts, info, tok, &minLen, &size);
if (size < map->minSize) {
/* missing input -> error */
if ((map->flags & CLF_OPTIONAL)) {
continue;
}
goto not_match;
}
/* string 2 number, put number into info structure by offset */
if (map->offs) {
p = yyInput; x = p + size;
if (!(map->flags & (CLF_LOCALSEC|CLF_POSIXSEC))) {
if (_str2int((int *)(((char *)info) + map->offs),
p, x, sign) != TCL_OK) {
goto overflow;
}
p = x;
} else {
if (_str2wideInt((Tcl_WideInt *)(((char *)info) + map->offs),
p, x, sign) != TCL_OK) {
goto overflow;
}
p = x;
}
flags = (flags & ~map->clearFlags) | map->flags;
}
}
break;
case CTOKT_PARSER:
switch (map->parser(opts, info, tok)) {
case TCL_OK:
break;
case TCL_RETURN:
if ((map->flags & CLF_OPTIONAL)) {
yyInput = p;
continue;
}
goto not_match;
break;
default:
goto done;
break;
};
/* decrement count for possible spaces in match */
while (p < yyInput) {
if (isspace(UCHAR(*p++))) {
yySpaceCount--;
}
}
p = yyInput;
flags = (flags & ~map->clearFlags) | map->flags;
break;
case CTOKT_SPACE:
/* at least one space */
if (!isspace(UCHAR(*p))) {
/* unmatched -> error */
goto not_match;
}
yySpaceCount--;
p++;
while (p < end && isspace(UCHAR(*p))) {
yySpaceCount--;
p++;
}
break;
case CTOKT_WORD:
x = FindWordEnd(tok, p, end);
if (!x) {
/* no match -> error */
goto not_match;
}
p = x;
break;
case CTOKT_CHAR:
x = (char *)map->data;
if (*x != *p) {
/* no match -> error */
goto not_match;
}
if (isspace(UCHAR(*x))) {
yySpaceCount--;
}
p++;
break;
}
}
/* check end was reached */
if (p < end) {
/* something after last token - wrong format */
goto not_match;
}
/* end of string, check only optional tokens at end, otherwise - not match */
while (tok->map != NULL) {
if (!(opts->flags & CLF_STRICT) && (tok->map->type == CTOKT_SPACE)) {
tok++;
if (tok->map == NULL) break;
}
if (!(tok->map->flags & CLF_OPTIONAL)) {
goto not_match;
}
tok++;
}
/*
* Invalidate result
*/
/* seconds token (%s) take precedence over all other tokens */
if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_POSIXSEC)) {
if (flags & CLF_DATE) {
if (!(flags & CLF_JULIANDAY)) {
info->flags |= CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY;
/* dd precedence below ddd */
switch (flags & (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH)) {
case (CLF_DAYOFYEAR|CLF_DAYOFMONTH):
/* miss month: ddd over dd (without month) */
flags &= ~CLF_DAYOFMONTH;
case (CLF_DAYOFYEAR):
/* ddd over naked weekday */
if (!(flags & CLF_ISO8601YEAR)) {
flags &= ~CLF_ISO8601;
}
break;
case (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH):
/* both available: mmdd over ddd */
flags &= ~CLF_DAYOFYEAR;
case (CLF_MONTH|CLF_DAYOFMONTH):
case (CLF_DAYOFMONTH):
/* mmdd / dd over naked weekday */
if (!(flags & CLF_ISO8601YEAR)) {
flags &= ~CLF_ISO8601;
}
break;
}
/* YearWeekDay below YearMonthDay */
if ( (flags & CLF_ISO8601)
&& ( (flags & (CLF_YEAR|CLF_DAYOFYEAR)) == (CLF_YEAR|CLF_DAYOFYEAR)
|| (flags & (CLF_YEAR|CLF_DAYOFMONTH|CLF_MONTH)) == (CLF_YEAR|CLF_DAYOFMONTH|CLF_MONTH)
)
) {
/* yy precedence below yyyy */
if (!(flags & CLF_ISO8601CENTURY) && (flags & CLF_CENTURY)) {
/* normally precedence of ISO is higher, but no century - so put it down */
flags &= ~CLF_ISO8601;
}
else
/* yymmdd or yyddd over naked weekday */
if (!(flags & CLF_ISO8601YEAR)) {
flags &= ~CLF_ISO8601;
}
}
if (!(flags & CLF_ISO8601)) {
if (yyYear < 100) {
if (!(flags & CLF_CENTURY)) {
if (yyYear >= dataPtr->yearOfCenturySwitch) {
yyYear -= 100;
}
yyYear += dataPtr->currentYearCentury;
} else {
yyYear += info->dateCentury * 100;
}
}
} else {
if (info->date.iso8601Year < 100) {
if (!(flags & CLF_ISO8601CENTURY)) {
if (info->date.iso8601Year >= dataPtr->yearOfCenturySwitch) {
info->date.iso8601Year -= 100;
}
info->date.iso8601Year += dataPtr->currentYearCentury;
} else {
info->date.iso8601Year += info->dateCentury * 100;
}
}
}
}
}
/* if no time - reset time */
if (!(flags & (CLF_TIME|CLF_LOCALSEC|CLF_POSIXSEC))) {
info->flags |= CLF_ASSEMBLE_SECONDS;
yydate.localSeconds = 0;
}
if (flags & CLF_TIME) {
info->flags |= CLF_ASSEMBLE_SECONDS;
yySeconds = ToSeconds(yyHour, yyMinutes,
yySeconds, yyMeridian);
} else
if (!(flags & (CLF_LOCALSEC|CLF_POSIXSEC))) {
info->flags |= CLF_ASSEMBLE_SECONDS;
yySeconds = yydate.localSeconds % SECONDS_PER_DAY;
}
}
/* tell caller which flags were set */
info->flags |= flags;
ret = TCL_OK;
goto done;
overflow:
Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("requested date too large to represent",
-1));
Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL);
goto done;
not_match:
Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("input string does not match supplied format",
-1));
Tcl_SetErrorCode(opts->interp, "CLOCK", "badInputString", NULL);
done:
return ret;
}
static inline int
FrmResultAllocate(
register DateFormat *dateFmt,
int len)
{
int needed = dateFmt->output + len - dateFmt->resEnd;
if (needed >= 0) { /* >= 0 - regards NTS zero */
int newsize = dateFmt->resEnd - dateFmt->resMem
+ needed + MIN_FMT_RESULT_BLOCK_ALLOC;
char *newRes = ckrealloc(dateFmt->resMem, newsize);
if (newRes == NULL) {
return TCL_ERROR;
}
dateFmt->output = newRes + (dateFmt->output - dateFmt->resMem);
dateFmt->resMem = newRes;
dateFmt->resEnd = newRes + newsize;
}
return TCL_OK;
}
static int
ClockFmtToken_HourAMPM_Proc(
ClockFmtScnCmdArgs *opts,
DateFormat *dateFmt,
ClockFormatToken *tok,
int *val)
{
*val = ( ( ( *val % SECONDS_PER_DAY ) + SECONDS_PER_DAY - 3600 ) / 3600 ) % 12 + 1;
return TCL_OK;
}
static int
ClockFmtToken_AMPM_Proc(
ClockFmtScnCmdArgs *opts,
DateFormat *dateFmt,
ClockFormatToken *tok,
int *val)
{
Tcl_Obj *mcObj;
const char *s;
int len;
if ((*val % SECONDS_PER_DAY) < (SECONDS_PER_DAY / 2)) {
mcObj = ClockMCGet(opts, MCLIT_AM);
} else {
mcObj = ClockMCGet(opts, MCLIT_PM);
}
if (mcObj == NULL) {
return TCL_ERROR;
}
s = TclGetString(mcObj); len = mcObj->length;
if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; };
memcpy(dateFmt->output, s, len + 1);
if (*tok->tokWord.start == 'p') {
len = Tcl_UtfToUpper(dateFmt->output);
}
dateFmt->output += len;
return TCL_OK;
}
static int
ClockFmtToken_StarDate_Proc(
ClockFmtScnCmdArgs *opts,
DateFormat *dateFmt,
ClockFormatToken *tok,
int *val)
{
int fractYear;
/* Get day of year, zero based */
int v = dateFmt->date.dayOfYear - 1;
/* Convert day of year to a fractional year */
if (IsGregorianLeapYear(&dateFmt->date)) {
fractYear = 1000 * v / 366;
} else {
fractYear = 1000 * v / 365;
}
/* Put together the StarDate as "Stardate %02d%03d.%1d" */
if (FrmResultAllocate(dateFmt, 30) != TCL_OK) { return TCL_ERROR; };
memcpy(dateFmt->output, "Stardate ", 9);
dateFmt->output += 9;
dateFmt->output = _itoaw(dateFmt->output,
dateFmt->date.year - RODDENBERRY, '0', 2);
dateFmt->output = _itoaw(dateFmt->output,
fractYear, '0', 3);
*dateFmt->output++ = '.';
/* be sure positive after decimal point (note: clock-value can be negative) */
v = dateFmt->date.localSeconds % SECONDS_PER_DAY / ( SECONDS_PER_DAY / 10 );
if (v < 0) v = 10 + v;
dateFmt->output = _itoaw(dateFmt->output, v, '0', 1);
return TCL_OK;
}
static int
ClockFmtToken_WeekOfYear_Proc(
ClockFmtScnCmdArgs *opts,
DateFormat *dateFmt,
ClockFormatToken *tok,
int *val)
{
int dow = dateFmt->date.dayOfWeek;
if (*tok->tokWord.start == 'U') {
if (dow == 7) {
dow = 0;
}
dow++;
}
*val = ( dateFmt->date.dayOfYear - dow + 7 ) / 7;
return TCL_OK;
}
static int
ClockFmtToken_TimeZone_Proc(
ClockFmtScnCmdArgs *opts,
DateFormat *dateFmt,
ClockFormatToken *tok,
int *val)
{
if (*tok->tokWord.start == 'z') {
int z = dateFmt->date.tzOffset;
char sign = '+';
if ( z < 0 ) {
z = -z;
sign = '-';
}
if (FrmResultAllocate(dateFmt, 7) != TCL_OK) { return TCL_ERROR; };
*dateFmt->output++ = sign;
dateFmt->output = _itoaw(dateFmt->output, z / 3600, '0', 2);
z %= 3600;
dateFmt->output = _itoaw(dateFmt->output, z / 60, '0', 2);
z %= 60;
if (z != 0) {
dateFmt->output = _itoaw(dateFmt->output, z, '0', 2);
}
} else {
Tcl_Obj * objPtr;
const char *s; int len;
/* convert seconds to local seconds to obtain tzName object */
if (ConvertUTCToLocal(opts->clientData, opts->interp,
&dateFmt->date, opts->timezoneObj,
GREGORIAN_CHANGE_DATE) != TCL_OK) {
return TCL_ERROR;
};
objPtr = dateFmt->date.tzName;
s = TclGetString(objPtr);
len = objPtr->length;
if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; };
memcpy(dateFmt->output, s, len + 1);
dateFmt->output += len;
}
return TCL_OK;
}
static int
ClockFmtToken_LocaleERA_Proc(
ClockFmtScnCmdArgs *opts,
DateFormat *dateFmt,
ClockFormatToken *tok,
int *val)
{
Tcl_Obj *mcObj;
const char *s;
int len;
if (dateFmt->date.era == BCE) {
mcObj = ClockMCGet(opts, MCLIT_BCE);
} else {
mcObj = ClockMCGet(opts, MCLIT_CE);
}
if (mcObj == NULL) {
return TCL_ERROR;
}
s = TclGetString(mcObj); len = mcObj->length;
if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; };
memcpy(dateFmt->output, s, len + 1);
dateFmt->output += len;
return TCL_OK;
}
static int
ClockFmtToken_LocaleERAYear_Proc(
ClockFmtScnCmdArgs *opts,
DateFormat *dateFmt,
ClockFormatToken *tok,
int *val)
{
int rowc;
Tcl_Obj **rowv;
if (dateFmt->localeEra == NULL) {
Tcl_Obj *mcObj = ClockMCGet(opts, MCLIT_LOCALE_ERAS);
if (mcObj == NULL) {
return TCL_ERROR;
}
if (TclListObjGetElements(opts->interp, mcObj, &rowc, &rowv) != TCL_OK) {
return TCL_ERROR;
}
if (rowc != 0) {
dateFmt->localeEra = LookupLastTransition(opts->interp,
dateFmt->date.localSeconds, rowc, rowv, NULL);
}
if (dateFmt->localeEra == NULL) {
dateFmt->localeEra = (Tcl_Obj*)1;
}
}
/* if no LOCALE_ERAS in catalog or era not found */
if (dateFmt->localeEra == (Tcl_Obj*)1) {
if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { return TCL_ERROR; };
if (*tok->tokWord.start == 'C') { /* %EC */
*val = dateFmt->date.year / 100;
dateFmt->output = _itoaw(dateFmt->output,
*val, '0', 2);
} else { /* %Ey */
*val = dateFmt->date.year % 100;
dateFmt->output = _itoaw(dateFmt->output,
*val, '0', 2);
}
} else {
Tcl_Obj *objPtr;
const char *s;
int len;
if (*tok->tokWord.start == 'C') { /* %EC */
if (Tcl_ListObjIndex(opts->interp, dateFmt->localeEra, 1,
&objPtr) != TCL_OK ) {
return TCL_ERROR;
}
} else { /* %Ey */
if (Tcl_ListObjIndex(opts->interp, dateFmt->localeEra, 2,
&objPtr) != TCL_OK ) {
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(opts->interp, objPtr, val) != TCL_OK) {
return TCL_ERROR;
}
*val = dateFmt->date.year - *val;
/* if year in locale numerals */
if (*val >= 0 && *val < 100) {
/* year as integer */
Tcl_Obj * mcObj = ClockMCGet(opts, MCLIT_LOCALE_NUMERALS);
if (mcObj == NULL) {
return TCL_ERROR;
}
if (Tcl_ListObjIndex(opts->interp, mcObj, *val, &objPtr) != TCL_OK) {
return TCL_ERROR;
}
} else {
/* year as integer */
if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { return TCL_ERROR; };
dateFmt->output = _itoaw(dateFmt->output,
*val, '0', 2);
return TCL_OK;
}
}
s = TclGetString(objPtr);
len = objPtr->length;
if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; };
memcpy(dateFmt->output, s, len + 1);
dateFmt->output += len;
}
return TCL_OK;
}
static const char *FmtSTokenMapIndex =
"demNbByYCHMSIklpaAuwUVzgGjJsntQ";
static ClockFormatTokenMap FmtSTokenMap[] = {
/* %d */
{CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL},
/* %e */
{CFMTT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL},
/* %m */
{CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL},
/* %N */
{CFMTT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL},
/* %b %h */
{CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month),
NULL, (void *)MCLIT_MONTHS_ABBREV},
/* %B */
{CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month),
NULL, (void *)MCLIT_MONTHS_FULL},
/* %y */
{CFMTT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.year), NULL},
/* %Y */
{CFMTT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.year), NULL},
/* %C */
{CFMTT_INT, "0", 2, 0, 100, 0, TclOffset(DateFormat, date.year), NULL},
/* %H */
{CFMTT_INT, "0", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL},
/* %M */
{CFMTT_INT, "0", 2, 0, 60, 60, TclOffset(DateFormat, date.secondOfDay), NULL},
/* %S */
{CFMTT_INT, "0", 2, 0, 0, 60, TclOffset(DateFormat, date.secondOfDay), NULL},
/* %I */
{CFMTT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.secondOfDay),
ClockFmtToken_HourAMPM_Proc, NULL},
/* %k */
{CFMTT_INT, " ", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL},
/* %l */
{CFMTT_INT, " ", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.secondOfDay),
ClockFmtToken_HourAMPM_Proc, NULL},
/* %p %P */
{CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.secondOfDay),
ClockFmtToken_AMPM_Proc, NULL},
/* %a */
{CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek),
NULL, (void *)MCLIT_DAYS_OF_WEEK_ABBREV},
/* %A */
{CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek),
NULL, (void *)MCLIT_DAYS_OF_WEEK_FULL},
/* %u */
{CFMTT_INT, " ", 1, 0, 0, 0, TclOffset(DateFormat, date.dayOfWeek), NULL},
/* %w */
{CFMTT_INT, " ", 1, 0, 0, 7, TclOffset(DateFormat, date.dayOfWeek), NULL},
/* %U %W */
{CFMTT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.dayOfYear),
ClockFmtToken_WeekOfYear_Proc, NULL},
/* %V */
{CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.iso8601Week), NULL},
/* %z %Z */
{CFMTT_INT, NULL, 0, 0, 0, 0, 0,
ClockFmtToken_TimeZone_Proc, NULL},
/* %g */
{CFMTT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.iso8601Year), NULL},
/* %G */
{CFMTT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.iso8601Year), NULL},
/* %j */
{CFMTT_INT, "0", 3, 0, 0, 0, TclOffset(DateFormat, date.dayOfYear), NULL},
/* %J */
{CFMTT_INT, "0", 7, 0, 0, 0, TclOffset(DateFormat, date.julianDay), NULL},
/* %s */
{CFMTT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.seconds), NULL},
/* %n */
{CTOKT_CHAR, "\n", 0, 0, 0, 0, 0, NULL},
/* %t */
{CTOKT_CHAR, "\t", 0, 0, 0, 0, 0, NULL},
/* %Q */
{CFMTT_INT, NULL, 0, 0, 0, 0, 0,
ClockFmtToken_StarDate_Proc, NULL},
};
static const char *FmtSTokenMapAliasIndex[2] = {
"hPWZ",
"bpUz"
};
static const char *FmtETokenMapIndex =
"Eys";
static ClockFormatTokenMap FmtETokenMap[] = {
/* %EE */
{CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.era),
ClockFmtToken_LocaleERA_Proc, NULL},
/* %Ey %EC */
{CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.year),
ClockFmtToken_LocaleERAYear_Proc, NULL},
/* %Es */
{CFMTT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.localSeconds), NULL},
};
static const char *FmtETokenMapAliasIndex[2] = {
"C",
"y"
};
static const char *FmtOTokenMapIndex =
"dmyHIMSuw";
static ClockFormatTokenMap FmtOTokenMap[] = {
/* %Od %Oe */
{CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.dayOfMonth),
NULL, (void *)MCLIT_LOCALE_NUMERALS},
/* %Om */
{CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.month),
NULL, (void *)MCLIT_LOCALE_NUMERALS},
/* %Oy */
{CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.year),
NULL, (void *)MCLIT_LOCALE_NUMERALS},
/* %OH %Ok */
{CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 3600, 24, TclOffset(DateFormat, date.secondOfDay),
NULL, (void *)MCLIT_LOCALE_NUMERALS},
/* %OI %Ol */
{CFMTT_INT, NULL, 0, CLFMT_CALC | CLFMT_LOCALE_INDX, 0, 0, TclOffset(DateFormat, date.secondOfDay),
ClockFmtToken_HourAMPM_Proc, (void *)MCLIT_LOCALE_NUMERALS},
/* %OM */
{CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 60, 60, TclOffset(DateFormat, date.secondOfDay),
NULL, (void *)MCLIT_LOCALE_NUMERALS},
/* %OS */
{CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 60, TclOffset(DateFormat, date.secondOfDay),
NULL, (void *)MCLIT_LOCALE_NUMERALS},
/* %Ou */
{CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.dayOfWeek),
NULL, (void *)MCLIT_LOCALE_NUMERALS},
/* %Ow */
{CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek),
NULL, (void *)MCLIT_LOCALE_NUMERALS},
};
static const char *FmtOTokenMapAliasIndex[2] = {
"ekl",
"dHI"
};
static ClockFormatTokenMap FmtWordTokenMap = {
CTOKT_WORD, NULL, 0, 0, 0, 0, 0, NULL
};
/*
*----------------------------------------------------------------------
*/
ClockFmtScnStorage *
ClockGetOrParseFmtFormat(
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Obj *formatObj) /* Format container */
{
ClockFmtScnStorage *fss;
ClockFormatToken *tok;
fss = Tcl_GetClockFrmScnFromObj(interp, formatObj);
if (fss == NULL) {
return NULL;
}
/* if first time scanning - tokenize format */
if (fss->fmtTok == NULL) {
unsigned int tokCnt;
register const char *p, *e, *cp;
e = p = HashEntry4FmtScn(fss)->key.string;
e += strlen(p);
/* estimate token count by % char and format length */
fss->fmtTokC = EstimateTokenCount(p, e);
Tcl_MutexLock(&ClockFmtMutex);
fss->fmtTok = tok = ckalloc(sizeof(*tok) * fss->fmtTokC);
memset(tok, 0, sizeof(*(tok)));
tokCnt = 1;
while (p < e) {
switch (*p) {
case '%':
if (1) {
ClockFormatTokenMap * fmtMap = FmtSTokenMap;
const char *mapIndex = FmtSTokenMapIndex,
**aliasIndex = FmtSTokenMapAliasIndex;
if (p+1 >= e) {
goto word_tok;
}
p++;
/* try to find modifier: */
switch (*p) {
case '%':
/* begin new word token - don't join with previous word token,
* because current mapping should be "...%%..." -> "...%..." */
tok->map = &FmtWordTokenMap;
tok->tokWord.start = p;
tok->tokWord.end = p+1;
AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); tokCnt++;
p++;
continue;
break;
case 'E':
fmtMap = FmtETokenMap,
mapIndex = FmtETokenMapIndex,
aliasIndex = FmtETokenMapAliasIndex;
p++;
break;
case 'O':
fmtMap = FmtOTokenMap,
mapIndex = FmtOTokenMapIndex,
aliasIndex = FmtOTokenMapAliasIndex;
p++;
break;
}
/* search direct index */
cp = strchr(mapIndex, *p);
if (!cp || *cp == '\0') {
/* search wrapper index (multiple chars for same token) */
cp = strchr(aliasIndex[0], *p);
if (!cp || *cp == '\0') {
p--; if (fmtMap != FmtSTokenMap) p--;
goto word_tok;
}
cp = strchr(mapIndex, aliasIndex[1][cp - aliasIndex[0]]);
if (!cp || *cp == '\0') { /* unexpected, but ... */
#ifdef DEBUG
Tcl_Panic("token \"%c\" has no map in wrapper resolver", *p);
#endif
p--; if (fmtMap != FmtSTokenMap) p--;
goto word_tok;
}
}
tok->map = &fmtMap[cp - mapIndex];
tok->tokWord.start = p;
/* next token */
AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); tokCnt++;
p++;
continue;
}
break;
default:
word_tok:
if (1) {
ClockFormatToken *wordTok = tok;
if (tok > fss->fmtTok && (tok-1)->map == &FmtWordTokenMap) {
wordTok = tok-1;
}
if (wordTok == tok) {
wordTok->tokWord.start = p;
wordTok->map = &FmtWordTokenMap;
AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); tokCnt++;
}
p = TclUtfNext(p);
wordTok->tokWord.end = p;
}
break;
}
}
/* correct count of real used tokens and free mem if desired
* (1 is acceptable delta to prevent memory fragmentation) */
if (fss->fmtTokC > tokCnt + (CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE / 2)) {
if ( (tok = ckrealloc(fss->fmtTok, tokCnt * sizeof(*tok))) != NULL ) {
fss->fmtTok = tok;
}
}
fss->fmtTokC = tokCnt;
done:
Tcl_MutexUnlock(&ClockFmtMutex);
}
return fss;
}
/*
*----------------------------------------------------------------------
*/
int
ClockFormat(
register DateFormat *dateFmt, /* Date fields used for parsing & converting */
ClockFmtScnCmdArgs *opts) /* Command options */
{
ClockFmtScnStorage *fss;
ClockFormatToken *tok;
ClockFormatTokenMap *map;
/* get localized format */
if (ClockLocalizeFormat(opts) == NULL) {
return TCL_ERROR;
}
if ( !(fss = ClockGetOrParseFmtFormat(opts->interp, opts->formatObj))
|| !(tok = fss->fmtTok)
) {
return TCL_ERROR;
}
/* prepare formatting */
dateFmt->date.secondOfDay = (int)(dateFmt->date.localSeconds % SECONDS_PER_DAY);
if (dateFmt->date.secondOfDay < 0) {
dateFmt->date.secondOfDay += SECONDS_PER_DAY;
}
/* result container object */
dateFmt->resMem = ckalloc(MIN_FMT_RESULT_BLOCK_ALLOC);
if (dateFmt->resMem == NULL) {
return TCL_ERROR;
}
dateFmt->output = dateFmt->resMem;
dateFmt->resEnd = dateFmt->resMem + MIN_FMT_RESULT_BLOCK_ALLOC;
*dateFmt->output = '\0';
/* do format each token */
for (; tok->map != NULL; tok++) {
map = tok->map;
switch (map->type)
{
case CFMTT_INT:
if (1) {
int val = (int)*(int *)(((char *)dateFmt) + map->offs);
if (map->fmtproc == NULL) {
if (map->flags & CLFMT_DECR) {
val--;
}
if (map->flags & CLFMT_INCR) {
val++;
}
if (map->divider) {
val /= map->divider;
}
if (map->divmod) {
val %= map->divmod;
}
} else {
if (map->fmtproc(opts, dateFmt, tok, &val) != TCL_OK) {
goto done;
}
/* if not calculate only (output inside fmtproc) */
if (!(map->flags & CLFMT_CALC)) {
continue;
}
}
if (!(map->flags & CLFMT_LOCALE_INDX)) {
if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { goto error; };
if (map->width) {
dateFmt->output = _itoaw(dateFmt->output, val, *map->tostr, map->width);
} else {
dateFmt->output += sprintf(dateFmt->output, map->tostr, val);
}
} else {
const char *s;
Tcl_Obj * mcObj = ClockMCGet(opts, PTR2INT(map->data) /* mcKey */);
if (mcObj == NULL) {
goto error;
}
if ( Tcl_ListObjIndex(opts->interp, mcObj, val, &mcObj) != TCL_OK
|| mcObj == NULL
) {
goto error;
}
s = TclGetString(mcObj);
if (FrmResultAllocate(dateFmt, mcObj->length) != TCL_OK) { goto error; };
memcpy(dateFmt->output, s, mcObj->length + 1);
dateFmt->output += mcObj->length;
}
}
break;
case CFMTT_WIDE:
if (1) {
Tcl_WideInt val = *(Tcl_WideInt *)(((char *)dateFmt) + map->offs);
if (FrmResultAllocate(dateFmt, 21) != TCL_OK) { goto error; };
if (map->width) {
dateFmt->output = _witoaw(dateFmt->output, val, *map->tostr, map->width);
} else {
dateFmt->output += sprintf(dateFmt->output, map->tostr, val);
}
}
break;
case CTOKT_CHAR:
if (FrmResultAllocate(dateFmt, 1) != TCL_OK) { goto error; };
*dateFmt->output++ = *map->tostr;
break;
case CFMTT_PROC:
if (map->fmtproc(opts, dateFmt, tok, NULL) != TCL_OK) {
goto error;
};
break;
case CTOKT_WORD:
if (1) {
int len = tok->tokWord.end - tok->tokWord.start;
if (FrmResultAllocate(dateFmt, len) != TCL_OK) { goto error; };
if (len == 1) {
*dateFmt->output++ = *tok->tokWord.start;
} else {
memcpy(dateFmt->output, tok->tokWord.start, len);
dateFmt->output += len;
}
}
break;
}
}
goto done;
error:
ckfree(dateFmt->resMem);
dateFmt->resMem = NULL;
done:
if (dateFmt->resMem) {
Tcl_Obj * result = Tcl_NewObj();
result->length = dateFmt->output - dateFmt->resMem;
result->bytes = NULL;
result->bytes = ckrealloc(dateFmt->resMem, result->length+1);
if (result->bytes == NULL) {
result->bytes = dateFmt->resMem;
}
result->bytes[result->length] = '\0';
Tcl_SetObjResult(opts->interp, result);
return TCL_OK;
}
return TCL_ERROR;
}
MODULE_SCOPE void
ClockFrmScnClearCaches(void)
{
Tcl_MutexLock(&ClockFmtMutex);
/* clear caches ... */
Tcl_MutexUnlock(&ClockFmtMutex);
}
static void
ClockFrmScnFinalize(
ClientData clientData) /* Not used. */
{
Tcl_MutexLock(&ClockFmtMutex);
#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
/* clear GC */
ClockFmtScnStorage_GC.stackPtr = NULL;
ClockFmtScnStorage_GC.stackBound = NULL;
ClockFmtScnStorage_GC.count = 0;
#endif
if (initialized) {
Tcl_DeleteHashTable(&FmtScnHashTable);
initialized = 0;
}
Tcl_MutexUnlock(&ClockFmtMutex);
Tcl_MutexFinalize(&ClockFmtMutex);
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclCmdIL.c.
| ︙ | ︙ | |||
3678 3679 3680 3681 3682 3683 3684 |
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
int i, j, index, indices, length, nocase = 0, indexc;
int sortMode = SORTMODE_ASCII;
int group, groupSize, groupOffset, idx, allocatedIndexVector = 0;
Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
| | | 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 |
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
int i, j, index, indices, length, nocase = 0, indexc;
int sortMode = SORTMODE_ASCII;
int group, groupSize, groupOffset, idx, allocatedIndexVector = 0;
Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
SortElement *elementArray = NULL, *elementPtr;
SortInfo sortInfo; /* Information about this sort that needs to
* be passed to the comparison function. */
# define NUM_LISTS 30
SortElement *subList[NUM_LISTS+1];
/* This array holds pointers to temporary
* lists built during the merge sort. Element
* i of the array holds a list of length
|
| ︙ | ︙ | |||
3724 3725 3726 3727 3728 3729 3730 |
groupSize = 1;
groupOffset = 0;
indexPtr = NULL;
for (i = 1; i < objc-1; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
&index) != TCL_OK) {
sortInfo.resultCode = TCL_ERROR;
| | | | 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 |
groupSize = 1;
groupOffset = 0;
indexPtr = NULL;
for (i = 1; i < objc-1; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
&index) != TCL_OK) {
sortInfo.resultCode = TCL_ERROR;
goto done;
}
switch ((enum Lsort_Switches) index) {
case LSORT_ASCII:
sortInfo.sortMode = SORTMODE_ASCII;
break;
case LSORT_COMMAND:
if (i == objc-2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-command\" option must be followed "
"by comparison command", -1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
sortInfo.resultCode = TCL_ERROR;
goto done;
}
sortInfo.sortMode = SORTMODE_COMMAND;
cmdPtr = objv[i+1];
i++;
break;
case LSORT_DECREASING:
sortInfo.isIncreasing = 0;
|
| ︙ | ︙ | |||
3762 3763 3764 3765 3766 3767 3768 |
if (i == objc-2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-index\" option must be followed by list index",
-1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
sortInfo.resultCode = TCL_ERROR;
| | | | | 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 |
if (i == objc-2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-index\" option must be followed by list index",
-1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
sortInfo.resultCode = TCL_ERROR;
goto done;
}
if (TclListObjGetElements(interp, objv[i+1], &indexc,
&indexv) != TCL_OK) {
sortInfo.resultCode = TCL_ERROR;
goto done;
}
/*
* Check each of the indices for syntactic correctness. Note that
* we do not store the converted values here because we do not
* know if this is the only -index option yet and so we can't
* allocate any space; that happens after the scan through all the
* options is done.
*/
for (j=0 ; j<indexc ; j++) {
if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
&dummy) != TCL_OK) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (-index option item number %d)", j));
sortInfo.resultCode = TCL_ERROR;
goto done;
}
}
indexPtr = objv[i+1];
i++;
break;
}
case LSORT_INTEGER:
|
| ︙ | ︙ | |||
3813 3814 3815 3816 3817 3818 3819 |
case LSORT_STRIDE:
if (i == objc-2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-stride\" option must be "
"followed by stride length", -1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
sortInfo.resultCode = TCL_ERROR;
| | | | | 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 |
case LSORT_STRIDE:
if (i == objc-2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-stride\" option must be "
"followed by stride length", -1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
sortInfo.resultCode = TCL_ERROR;
goto done;
}
if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
sortInfo.resultCode = TCL_ERROR;
goto done;
}
if (groupSize < 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"stride length must be at least 2", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
"BADSTRIDE", NULL);
sortInfo.resultCode = TCL_ERROR;
goto done;
}
group = 1;
i++;
break;
}
}
if (nocase && (sortInfo.sortMode == SORTMODE_ASCII)) {
|
| ︙ | ︙ | |||
3880 3881 3882 3883 3884 3885 3886 |
* underneath our feet. Take a copy (cheap) to prevent this. [Bug
* 1675116]
*/
listObj = TclListObjCopy(interp, listObj);
if (listObj == NULL) {
sortInfo.resultCode = TCL_ERROR;
| | | | 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 |
* underneath our feet. Take a copy (cheap) to prevent this. [Bug
* 1675116]
*/
listObj = TclListObjCopy(interp, listObj);
if (listObj == NULL) {
sortInfo.resultCode = TCL_ERROR;
goto done;
}
/*
* The existing command is a list. We want to flatten it, append two
* dummy arguments on the end, and replace these arguments later.
*/
newCommandPtr = Tcl_DuplicateObj(cmdPtr);
TclNewObj(newObjPtr);
Tcl_IncrRefCount(newCommandPtr);
if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
!= TCL_OK) {
TclDecrRefCount(newCommandPtr);
TclDecrRefCount(listObj);
Tcl_IncrRefCount(newObjPtr);
TclDecrRefCount(newObjPtr);
sortInfo.resultCode = TCL_ERROR;
goto done;
}
Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
sortInfo.compareCmdPtr = newCommandPtr;
}
sortInfo.resultCode = TclListObjGetElements(interp, listObj,
&length, &listObjPtrs);
|
| ︙ | ︙ | |||
3991 3992 3993 3994 3995 3996 3997 |
}
/*
* The following loop creates a SortElement for each list element and
* begins sorting it into the sublists as it appears.
*/
| | | | | | 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 |
}
/*
* The following loop creates a SortElement for each list element and
* begins sorting it into the sublists as it appears.
*/
elementArray = ckalloc(length * sizeof(SortElement));
for (i=0; i < length; i++){
idx = groupSize * i + groupOffset;
if (indexc) {
/*
* If this is an indexed sort, retrieve the corresponding element
*/
indexPtr = SelectObjFromSublist(listObjPtrs[idx], &sortInfo);
if (sortInfo.resultCode != TCL_OK) {
goto done;
}
} else {
indexPtr = listObjPtrs[idx];
}
/*
* Determine the "value" of this object for sorting purposes
*/
if (sortMode == SORTMODE_ASCII) {
elementArray[i].collationKey.strValuePtr = TclGetString(indexPtr);
} else if (sortMode == SORTMODE_INTEGER) {
Tcl_WideInt a;
if (TclGetWideIntFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
sortInfo.resultCode = TCL_ERROR;
goto done;
}
elementArray[i].collationKey.wideValue = a;
} else if (sortMode == SORTMODE_REAL) {
double a;
if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr,
&a) != TCL_OK) {
sortInfo.resultCode = TCL_ERROR;
goto done;
}
elementArray[i].collationKey.doubleValue = a;
} else {
elementArray[i].collationKey.objValuePtr = indexPtr;
}
/*
|
| ︙ | ︙ | |||
4114 4115 4116 4117 4118 4119 4120 |
Tcl_IncrRefCount(objPtr);
}
}
listRepPtr->elemCount = i;
Tcl_SetObjResult(interp, resultPtr);
}
| < < < < > > > | 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 |
Tcl_IncrRefCount(objPtr);
}
}
listRepPtr->elemCount = i;
Tcl_SetObjResult(interp, resultPtr);
}
done:
if (sortMode == SORTMODE_COMMAND) {
TclDecrRefCount(sortInfo.compareCmdPtr);
TclDecrRefCount(listObj);
sortInfo.compareCmdPtr = NULL;
}
if (allocatedIndexVector) {
TclStackFree(interp, sortInfo.indexv);
}
if (elementArray) {
ckfree(elementArray);
}
return sortInfo.resultCode;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ |
Changes to generic/tclCmdMZ.c.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 | * Copyright (c) 2003-2009 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclRegexp.h" #include "tclStringTrim.h" static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode, Tcl_Obj *oldOptions, Tcl_Obj *errorInfo); static Tcl_NRPostProc SwitchPostProc; static Tcl_NRPostProc TryPostBody; | > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | * Copyright (c) 2003-2009 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include "tclRegexp.h" #include "tclStringTrim.h" static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode, Tcl_Obj *oldOptions, Tcl_Obj *errorInfo); static Tcl_NRPostProc SwitchPostProc; static Tcl_NRPostProc TryPostBody; |
| ︙ | ︙ | |||
4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 |
TclNewLiteralStringObj(objs[1], "microseconds");
TclNewLiteralStringObj(objs[2], "per");
TclNewLiteralStringObj(objs[3], "iteration");
Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_TryObjCmd, TclNRTryObjCmd --
*
* This procedure is invoked to process the "try" Tcl command. See the
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 |
TclNewLiteralStringObj(objs[1], "microseconds");
TclNewLiteralStringObj(objs[2], "per");
TclNewLiteralStringObj(objs[3], "iteration");
Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_TimeRateObjCmd --
*
* This object-based procedure is invoked to process the "timerate" Tcl
* command.
* This is similar to command "time", except the execution limited by
* given time (in milliseconds) instead of repetition count.
*
* Example:
* timerate {after 5} 1000 ; # equivalent for `time {after 5} [expr 1000/5]`
*
* Results:
* A standard Tcl object result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
int
Tcl_TimeRateObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static
double measureOverhead = 0; /* global measure-overhead */
double overhead = -1; /* given measure-overhead */
register Tcl_Obj *objPtr;
register int result, i;
Tcl_Obj *calibrate = NULL, *direct = NULL;
Tcl_WideInt count = 0; /* Holds repetition count */
Tcl_WideInt maxms = -0x7FFFFFFFFFFFFFFFL;
/* Maximal running time (in milliseconds) */
Tcl_WideInt threshold = 1; /* Current threshold for check time (faster
* repeat count without time check) */
Tcl_WideInt maxIterTm = 1; /* Max time of some iteration as max threshold
* additionally avoid divide to zero (never < 1) */
register Tcl_WideInt start, middle, stop;
#ifndef TCL_WIDE_CLICKS
Tcl_Time now;
#endif
static const char *const options[] = {
"-direct", "-overhead", "-calibrate", "--", NULL
};
enum options {
TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST
};
NRE_callback *rootPtr;
ByteCode *codePtr = NULL;
for (i = 1; i < objc - 1; i++) {
int index;
if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
&index) != TCL_OK) {
break;
}
if (index == TMRT_LAST) {
i++;
break;
}
switch (index) {
case TMRT_EV_DIRECT:
direct = objv[i];
break;
case TMRT_OVERHEAD:
if (++i >= objc - 1) {
goto usage;
}
if (Tcl_GetDoubleFromObj(interp, objv[i], &overhead) != TCL_OK) {
return TCL_ERROR;
}
break;
case TMRT_CALIBRATE:
calibrate = objv[i];
break;
}
}
if (i >= objc || i < objc-2) {
usage:
Tcl_WrongNumArgs(interp, 1, objv, "?-direct? ?-calibrate? ?-overhead double? command ?time?");
return TCL_ERROR;
}
objPtr = objv[i++];
if (i < objc) {
result = TclGetWideIntFromObj(interp, objv[i], &maxms);
if (result != TCL_OK) {
return result;
}
}
/* if calibrate */
if (calibrate) {
/* if no time specified for the calibration */
if (maxms == -0x7FFFFFFFFFFFFFFFL) {
Tcl_Obj *clobjv[6];
Tcl_WideInt maxCalTime = 5000;
double lastMeasureOverhead = measureOverhead;
clobjv[0] = objv[0];
i = 1;
if (direct) {
clobjv[i++] = direct;
}
clobjv[i++] = objPtr;
/* reset last measurement overhead */
measureOverhead = (double)0;
/* self-call with 100 milliseconds to warm-up,
* before entering the calibration cycle */
TclNewLongObj(clobjv[i], 100);
Tcl_IncrRefCount(clobjv[i]);
result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv);
Tcl_DecrRefCount(clobjv[i]);
if (result != TCL_OK) {
return result;
}
i--;
clobjv[i++] = calibrate;
clobjv[i++] = objPtr;
/* set last measurement overhead to max */
measureOverhead = (double)0x7FFFFFFFFFFFFFFFL;
/* calibration cycle until it'll be preciser */
maxms = -1000;
do {
lastMeasureOverhead = measureOverhead;
TclNewLongObj(clobjv[i], (int)maxms);
Tcl_IncrRefCount(clobjv[i]);
result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv);
Tcl_DecrRefCount(clobjv[i]);
if (result != TCL_OK) {
return result;
}
maxCalTime += maxms;
/* increase maxms for preciser calibration */
maxms -= (-maxms / 4);
/* as long as new value more as 0.05% better */
} while ( (measureOverhead >= lastMeasureOverhead
|| measureOverhead / lastMeasureOverhead <= 0.9995)
&& maxCalTime > 0
);
return result;
}
if (maxms == 0) {
/* reset last measurement overhead */
measureOverhead = 0;
Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
return TCL_OK;
}
/* if time is negative - make current overhead more precise */
if (maxms > 0) {
/* set last measurement overhead to max */
measureOverhead = (double)0x7FFFFFFFFFFFFFFFL;
} else {
maxms = -maxms;
}
}
if (maxms == -0x7FFFFFFFFFFFFFFFL) {
maxms = 1000;
}
if (overhead == -1) {
overhead = measureOverhead;
}
/* be sure that resetting of result will not smudge the further measurement */
Tcl_ResetResult(interp);
/* compile object */
if (!direct) {
if (TclInterpReady(interp) != TCL_OK) {
return TCL_ERROR;
}
codePtr = TclCompileObj(interp, objPtr, NULL, 0);
TclPreserveByteCode(codePtr);
}
/* get start and stop time */
#ifdef TCL_WIDE_CLICKS
start = middle = TclpGetWideClicks();
/* time to stop execution (in wide clicks) */
stop = start + (maxms * 1000 / TclpWideClickInMicrosec());
#else
Tcl_GetTime(&now);
start = now.sec; start *= 1000000; start += now.usec;
middle = start;
/* time to stop execution (in microsecs) */
stop = start + maxms * 1000;
#endif
/* start measurement */
while (1) {
/* eval single iteration */
count++;
if (!direct) {
/* precompiled */
rootPtr = TOP_CB(interp);
result = TclNRExecuteByteCode(interp, codePtr);
result = TclNRRunCallbacks(interp, result, rootPtr);
} else {
/* eval */
result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
}
if (result != TCL_OK) {
goto done;
}
/* don't check time up to threshold */
if (--threshold > 0) continue;
/* check stop time reached, estimate new threshold */
#ifdef TCL_WIDE_CLICKS
middle = TclpGetWideClicks();
#else
Tcl_GetTime(&now);
middle = now.sec; middle *= 1000000; middle += now.usec;
#endif
if (middle >= stop) {
break;
}
/* don't calculate threshold by few iterations, because sometimes
* first iteration(s) can be too fast (cached, delayed clean up, etc) */
if (count < 10) {
threshold = 1; continue;
}
/* average iteration time in microsecs */
threshold = (middle - start) / count;
if (threshold > maxIterTm) {
maxIterTm = threshold;
}
/* as relation between remaining time and time since last check */
threshold = ((stop - middle) / maxIterTm) / 4;
if (threshold > 100000) { /* fix for too large threshold */
threshold = 100000;
}
}
{
Tcl_Obj *objarr[8], **objs = objarr;
Tcl_WideInt val;
const char *fmt;
middle -= start; /* execution time in microsecs */
#ifdef TCL_WIDE_CLICKS
/* convert execution time in wide clicks to microsecs */
middle *= TclpWideClickInMicrosec();
#endif
/* if not calibrate */
if (!calibrate) {
/* minimize influence of measurement overhead */
if (overhead > 0) {
/* estimate the time of overhead (microsecs) */
Tcl_WideInt curOverhead = overhead * count;
if (middle > curOverhead) {
middle -= curOverhead;
} else {
middle = 1;
}
}
} else {
/* calibration - obtaining new measurement overhead */
if (measureOverhead > (double)middle / count) {
measureOverhead = (double)middle / count;
}
objs[0] = Tcl_NewDoubleObj(measureOverhead);
TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
objs += 2;
}
val = middle / count; /* microsecs per iteration */
if (val >= 1000000) {
objs[0] = Tcl_NewWideIntObj(val);
} else {
if (val < 10) { fmt = "%.6f"; } else
if (val < 100) { fmt = "%.4f"; } else
if (val < 1000) { fmt = "%.3f"; } else
if (val < 10000) { fmt = "%.2f"; } else
{ fmt = "%.1f"; };
objs[0] = Tcl_ObjPrintf(fmt, ((double)middle)/count);
}
objs[2] = Tcl_NewWideIntObj(count); /* iterations */
/* calculate speed as rate (count) per sec */
if (!middle) middle++; /* +1 ms, just to avoid divide by zero */
if (count < (0x7FFFFFFFFFFFFFFFL / 1000000)) {
val = (count * 1000000) / middle;
if (val < 100000) {
if (val < 100) { fmt = "%.3f"; } else
if (val < 1000) { fmt = "%.2f"; } else
{ fmt = "%.1f"; };
objs[4] = Tcl_ObjPrintf(fmt, ((double)(count * 1000000)) / middle);
} else {
objs[4] = Tcl_NewWideIntObj(val);
}
} else {
objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000);
}
/* estimated net execution time (in millisecs) */
if (!calibrate) {
objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000);
TclNewLiteralStringObj(objs[7], "nett-ms");
}
/*
* Construct the result as a list because many programs have always parsed
* as such (extracting the first element, typically).
*/
TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#"); /* mics/# */
TclNewLiteralStringObj(objs[3], "#");
TclNewLiteralStringObj(objs[5], "#/sec");
Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr));
}
done:
if (codePtr != NULL) {
TclReleaseByteCode(codePtr);
}
return result;
}
/*
*----------------------------------------------------------------------
*
* Tcl_TryObjCmd, TclNRTryObjCmd --
*
* This procedure is invoked to process the "try" Tcl command. See the
|
| ︙ | ︙ |
Changes to generic/tclDate.c.
|
| | | | | | | | < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
/* A Bison parser, made by GNU Bison 2.4.2. */
/* Skeleton implementation for Bison's Yacc-like parsers in C
Copyright (C) 1984, 1989-1990, 2000-2006, 2009-2010 Free Software
Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
/* As a special exception, you may create a larger work that contains
part or all of the Bison parser skeleton and distribute that work
under terms of your choice, so long as that work isn't itself a
parser generator using the skeleton or a modified version thereof
as a parser skeleton. Alternatively, if you modify or redistribute
the parser skeleton itself, you may (at your option) remove this
|
| ︙ | ︙ | |||
43 44 45 46 47 48 49 | define necessary library symbols; they are noted "INFRINGES ON USER NAME SPACE" below. */ /* Identify Bison output. */ #define YYBISON 1 /* Bison version. */ | | > > > > > > | | | | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < > < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | define necessary library symbols; they are noted "INFRINGES ON USER NAME SPACE" below. */ /* Identify Bison output. */ #define YYBISON 1 /* Bison version. */ #define YYBISON_VERSION "2.4.2" /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" /* Pure parsers. */ #define YYPURE 1 /* Push parsers. */ #define YYPUSH 0 /* Pull parsers. */ #define YYPULL 1 /* Using locations. */ #define YYLSP_NEEDED 1 /* Substitute the variable and function names. */ #define yyparse TclDateparse #define yylex TclDatelex #define yyerror TclDateerror #define yylval TclDatelval #define yychar TclDatechar #define yydebug TclDatedebug #define yynerrs TclDatenerrs #define yylloc TclDatelloc /* Copy the first part of user declarations. */ /* * tclDate.c -- * * This file is generated from a yacc grammar defined in the file * tclGetDate.y. It should not be edited directly. * * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans. * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * */ #include "tclInt.h" /* * Bison generates several labels that happen to be unused. MS Visual C++ * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ #include "tclDate.h" #define YYMALLOC ckalloc #define YYFREE(x) (ckfree((void*) (x))) #define EPOCH 1970 #define START_OF_TIME 1902 #define END_OF_TIME 2037 /* * The offset of tm_year of struct tm returned by localtime, gmtime, etc. * Posix requires 1900. |
| ︙ | ︙ | |||
242 243 244 245 246 247 248 |
* Daylight-savings mode: on, off, or not yet known.
*/
typedef enum _DSTMODE {
DSTon, DSToff, DSTmaybe
} DSTMODE;
| < < < < < < < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > | | | > < | 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 |
* Daylight-savings mode: on, off, or not yet known.
*/
typedef enum _DSTMODE {
DSTon, DSToff, DSTmaybe
} DSTMODE;
/* Enabling traces. */
#ifndef YYDEBUG
# define YYDEBUG 0
#endif
/* Enabling verbose error messages. */
#ifdef YYERROR_VERBOSE
# undef YYERROR_VERBOSE
# define YYERROR_VERBOSE 1
#else
# define YYERROR_VERBOSE 0
#endif
/* Enabling the token table. */
#ifndef YYTOKEN_TABLE
# define YYTOKEN_TABLE 0
#endif
/* Tokens. */
#ifndef YYTOKENTYPE
# define YYTOKENTYPE
/* Put the tokens into the symbol table, so that GDB and other debuggers
know about them. */
enum yytokentype {
tAGO = 258,
tDAY = 259,
tDAYZONE = 260,
tID = 261,
tMERIDIAN = 262,
tMONTH = 263,
tMONTH_UNIT = 264,
tSTARDATE = 265,
tSEC_UNIT = 266,
tSNUMBER = 267,
tUNUMBER = 268,
tZONE = 269,
tEPOCH = 270,
tDST = 271,
tISOBASE = 272,
tDAY_UNIT = 273,
tNEXT = 274
};
#endif
#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
typedef union YYSTYPE
{
time_t Number;
enum _MERIDIAN Meridian;
} YYSTYPE;
# define YYSTYPE_IS_TRIVIAL 1
# define yystype YYSTYPE /* obsolescent; will be withdrawn */
# define YYSTYPE_IS_DECLARED 1
#endif
#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
typedef struct YYLTYPE
{
int first_line;
int first_column;
|
| ︙ | ︙ | |||
312 313 314 315 316 317 318 | */ static int LookupWord(YYSTYPE* yylvalPtr, char *buff); static void TclDateerror(YYLTYPE* location, DateInfo* info, const char *s); static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo* info); | < < < < | 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 | */ static int LookupWord(YYSTYPE* yylvalPtr, char *buff); static void TclDateerror(YYLTYPE* location, DateInfo* info, const char *s); static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo* info); MODULE_SCOPE int yyparse(DateInfo*); #ifdef short # undef short #endif #ifdef YYTYPE_UINT8 typedef YYTYPE_UINT8 yytype_uint8; |
| ︙ | ︙ | |||
355 356 357 358 359 360 361 362 | #else typedef short int yytype_int16; #endif #ifndef YYSIZE_T # ifdef __SIZE_TYPE__ # define YYSIZE_T __SIZE_TYPE__ # else | > > > > > > | | | 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 |
#else
typedef short int yytype_int16;
#endif
#ifndef YYSIZE_T
# ifdef __SIZE_TYPE__
# define YYSIZE_T __SIZE_TYPE__
# elif defined size_t
# define YYSIZE_T size_t
# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
|| defined __cplusplus || defined _MSC_VER)
# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
# define YYSIZE_T size_t
# else
# define YYSIZE_T unsigned int
# endif
#endif
#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
#ifndef YY_
# if defined YYENABLE_NLS && YYENABLE_NLS
# if ENABLE_NLS
# include <libintl.h> /* INFRINGES ON USER NAME SPACE */
# define YY_(msgid) dgettext ("bison-runtime", msgid)
# endif
# endif
# ifndef YY_
# define YY_(msgid) msgid
|
| ︙ | ︙ | |||
388 389 390 391 392 393 394 |
/* Identity function, used to suppress warnings about constant conditions. */
#ifndef lint
# define YYID(n) (n)
#else
#if (defined __STDC__ || defined __C99__FUNC__ \
|| defined __cplusplus || defined _MSC_VER)
static int
| | | | | | 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 |
/* Identity function, used to suppress warnings about constant conditions. */
#ifndef lint
# define YYID(n) (n)
#else
#if (defined __STDC__ || defined __C99__FUNC__ \
|| defined __cplusplus || defined _MSC_VER)
static int
YYID (int yyi)
#else
static int
YYID (yyi)
int yyi;
#endif
{
return yyi;
}
#endif
#if ! defined yyoverflow || YYERROR_VERBOSE
/* The parser invokes alloca or malloc; define the necessary symbols. */
|
| ︙ | ︙ | |||
477 478 479 480 481 482 483 |
&& (! defined __cplusplus \
|| (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
&& defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
/* A type that is properly aligned for any stack member. */
union yyalloc
{
| | | | | 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 |
&& (! defined __cplusplus \
|| (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
&& defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
/* A type that is properly aligned for any stack member. */
union yyalloc
{
yytype_int16 yyss_alloc;
YYSTYPE yyvs_alloc;
YYLTYPE yyls_alloc;
};
/* The size of the maximum gap between one aligned stack and the next. */
# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
/* The size of an array large to enough to hold all stacks, each with
N elements. */
|
| ︙ | ︙ | |||
514 515 516 517 518 519 520 | # endif /* Relocate STACK from its old location to the new one. The local variables YYSIZE and YYSTACKSIZE give the old and new number of elements in the stack, and YYPTR gives the new location of the stack. Advance YYPTR to a properly aligned location for the next stack. */ | | | | | 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 |
# endif
/* Relocate STACK from its old location to the new one. The
local variables YYSIZE and YYSTACKSIZE give the old and new number of
elements in the stack, and YYPTR gives the new location of the
stack. Advance YYPTR to a properly aligned location for the next
stack. */
# define YYSTACK_RELOCATE(Stack_alloc, Stack) \
do \
{ \
YYSIZE_T yynewbytes; \
YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \
Stack = &yyptr->Stack_alloc; \
yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
yyptr += yynewbytes / sizeof (*yyptr); \
} \
while (YYID (0))
#endif
|
| ︙ | ︙ | |||
620 621 622 623 624 625 626 |
13, 39, -1, 39, -1, 21, -1, 25, -1, 11,
-1, 18, -1, 9, -1, 13, -1, -1, 7, -1
};
/* YYRLINE[YYN] -- source line where rule number YYN was defined. */
static const yytype_uint16 yyrline[] =
{
| | | | > | < | | 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 |
13, 39, -1, 39, -1, 21, -1, 25, -1, 11,
-1, 18, -1, 9, -1, 13, -1, -1, 7, -1
};
/* YYRLINE[YYN] -- source line where rule number YYN was defined. */
static const yytype_uint16 yyrline[] =
{
0, 152, 152, 153, 156, 159, 162, 165, 168, 171,
174, 178, 183, 186, 192, 198, 206, 212, 223, 227,
231, 237, 241, 245, 249, 253, 259, 263, 268, 273,
278, 283, 287, 292, 296, 301, 308, 312, 318, 327,
336, 346, 360, 365, 368, 371, 374, 377, 380, 385,
388, 393, 397, 401, 407, 425, 428
};
#endif
#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
First, the terminals, then, starting at YYNTOKENS, nonterminals. */
static const char *const yytname[] =
|
| ︙ | ︙ | |||
779 780 781 782 783 784 785 | #define YYACCEPT goto yyacceptlab #define YYABORT goto yyabortlab #define YYERROR goto yyerrorlab /* Like YYERROR except do call yyerror. This remains here temporarily to ease the transition to the new meaning of YYERROR, for GCC. | | > > > > > > > > > | 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 |
#define YYACCEPT goto yyacceptlab
#define YYABORT goto yyabortlab
#define YYERROR goto yyerrorlab
/* Like YYERROR except do call yyerror. This remains here temporarily
to ease the transition to the new meaning of YYERROR, for GCC.
Once GCC version 2 has supplanted version 1, this can go. However,
YYFAIL appears to be in use. Nevertheless, it is formally deprecated
in Bison 2.4.2's NEWS entry, where a plan to phase it out is
discussed. */
#define YYFAIL goto yyerrlab
#if defined YYFAIL
/* This is here to suppress warnings from the GCC cpp's
-Wunused-macros. Normally we don't worry about that warning, but
some users do, and we want to make it easy for users to remove
YYFAIL uses, which will produce warnings from Bison 2.5. */
#endif
#define YYRECOVERING() (!!yyerrstatus)
#define YYBACKUP(Token, Value) \
do \
if (yychar == YYEMPTY && yylen == 1) \
{ \
|
| ︙ | ︙ | |||
838 839 840 841 842 843 844 | /* YY_LOCATION_PRINT -- Print the location on the stream. This macro was not mandated originally: define only if we know we won't break user code: when these are the locations we know. */ #ifndef YY_LOCATION_PRINT | | | 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 |
/* YY_LOCATION_PRINT -- Print the location on the stream.
This macro was not mandated originally: define only if we know
we won't break user code: when these are the locations we know. */
#ifndef YY_LOCATION_PRINT
# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
# define YY_LOCATION_PRINT(File, Loc) \
fprintf (File, "%d.%d-%d.%d", \
(Loc).first_line, (Loc).first_column, \
(Loc).last_line, (Loc).last_column)
# else
# define YY_LOCATION_PRINT(File, Loc) ((void) 0)
# endif
|
| ︙ | ︙ | |||
957 958 959 960 961 962 963 |
| yy_stack_print -- Print the state stack from its BOTTOM up to its |
| TOP (included). |
`------------------------------------------------------------------*/
#if (defined __STDC__ || defined __C99__FUNC__ \
|| defined __cplusplus || defined _MSC_VER)
static void
| | | | | | > > | > | 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 |
| yy_stack_print -- Print the state stack from its BOTTOM up to its |
| TOP (included). |
`------------------------------------------------------------------*/
#if (defined __STDC__ || defined __C99__FUNC__ \
|| defined __cplusplus || defined _MSC_VER)
static void
yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop)
#else
static void
yy_stack_print (yybottom, yytop)
yytype_int16 *yybottom;
yytype_int16 *yytop;
#endif
{
YYFPRINTF (stderr, "Stack now");
for (; yybottom <= yytop; yybottom++)
{
int yybot = *yybottom;
YYFPRINTF (stderr, " %d", yybot);
}
YYFPRINTF (stderr, "\n");
}
# define YY_STACK_PRINT(Bottom, Top) \
do { \
if (yydebug) \
yy_stack_print ((Bottom), (Top)); \
|
| ︙ | ︙ | |||
1003 1004 1005 1006 1007 1008 1009 |
int yyi;
unsigned long int yylno = yyrline[yyrule];
YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
yyrule - 1, yylno);
/* The symbols being reduced. */
for (yyi = 0; yyi < yynrhs; yyi++)
{
| | | | 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 |
int yyi;
unsigned long int yylno = yyrline[yyrule];
YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
yyrule - 1, yylno);
/* The symbols being reduced. */
for (yyi = 0; yyi < yynrhs; yyi++)
{
YYFPRINTF (stderr, " $%d = ", yyi + 1);
yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
&(yyvsp[(yyi + 1) - (yynrhs)])
, &(yylsp[(yyi + 1) - (yynrhs)]) , info);
YYFPRINTF (stderr, "\n");
}
}
# define YY_REDUCE_PRINT(Rule) \
do { \
if (yydebug) \
yy_reduce_print (yyvsp, yylsp, Rule, info); \
|
| ︙ | ︙ | |||
1291 1292 1293 1294 1295 1296 1297 |
switch (yytype)
{
default:
break;
}
}
| | < < < | | | | 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 |
switch (yytype)
{
default:
break;
}
}
/* Prevent warnings from -Wmissing-prototypes. */
#ifdef YYPARSE_PARAM
#if defined __STDC__ || defined __cplusplus
int yyparse (void *YYPARSE_PARAM);
#else
int yyparse ();
#endif
#else /* ! YYPARSE_PARAM */
#if defined __STDC__ || defined __cplusplus
int yyparse (DateInfo* info);
#else
int yyparse ();
#endif
#endif /* ! YYPARSE_PARAM */
/*-------------------------.
| yyparse or yypush_parse. |
`-------------------------*/
#ifdef YYPARSE_PARAM
#if (defined __STDC__ || defined __C99__FUNC__ \
|| defined __cplusplus || defined _MSC_VER)
int
yyparse (void *YYPARSE_PARAM)
#else
|
| ︙ | ︙ | |||
1340 1341 1342 1343 1344 1345 1346 |
#else
int
yyparse (info)
DateInfo* info;
#endif
#endif
{
| | | > > > | | | > > > > > > > > > > > > > > > > > > > > > > > > | > > > > | > < < | | > > > > > < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < > > > > > > | < > | | | 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 |
#else
int
yyparse (info)
DateInfo* info;
#endif
#endif
{
/* The lookahead symbol. */
int yychar;
/* The semantic value of the lookahead symbol. */
YYSTYPE yylval;
/* Location data for the lookahead symbol. */
YYLTYPE yylloc;
/* Number of syntax errors so far. */
int yynerrs;
int yystate;
/* Number of tokens to shift before error messages enabled. */
int yyerrstatus;
/* The stacks and their tools:
`yyss': related to states.
`yyvs': related to semantic values.
`yyls': related to locations.
Refer to the stacks thru separate pointers, to allow yyoverflow
to reallocate them elsewhere. */
/* The state stack. */
yytype_int16 yyssa[YYINITDEPTH];
yytype_int16 *yyss;
yytype_int16 *yyssp;
/* The semantic value stack. */
YYSTYPE yyvsa[YYINITDEPTH];
YYSTYPE *yyvs;
YYSTYPE *yyvsp;
/* The location stack. */
YYLTYPE yylsa[YYINITDEPTH];
YYLTYPE *yyls;
YYLTYPE *yylsp;
/* The locations where the error started and ended. */
YYLTYPE yyerror_range[2];
YYSIZE_T yystacksize;
int yyn;
int yyresult;
/* Lookahead token as an internal (translated) token number. */
int yytoken;
/* The variables used to return semantic value and location from the
action routines. */
YYSTYPE yyval;
YYLTYPE yyloc;
#if YYERROR_VERBOSE
/* Buffer for error messages, and its allocated size. */
char yymsgbuf[128];
char *yymsg = yymsgbuf;
YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
#endif
#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N))
/* The number of symbols on the RHS of the reduced rule.
Keep to zero when no symbol should be popped. */
int yylen = 0;
yytoken = 0;
yyss = yyssa;
yyvs = yyvsa;
yyls = yylsa;
yystacksize = YYINITDEPTH;
YYDPRINTF ((stderr, "Starting parse\n"));
yystate = 0;
yyerrstatus = 0;
yynerrs = 0;
yychar = YYEMPTY; /* Cause a token to be read. */
/* Initialize stack pointers.
Waste one element of value and location stack
so that they stay on the same level as the state stack.
The wasted elements are never initialized. */
yyssp = yyss;
yyvsp = yyvs;
yylsp = yyls;
#if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
/* Initialize the default location before parsing starts. */
yylloc.first_line = yylloc.last_line = 1;
yylloc.first_column = yylloc.last_column = 1;
#endif
goto yysetstate;
/*------------------------------------------------------------.
| yynewstate -- Push a new state, which is found in yystate. |
`------------------------------------------------------------*/
|
| ︙ | ︙ | |||
1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 |
conditional around just the two extra args, but that might
be undefined if yyoverflow is a macro. */
yyoverflow (YY_("memory exhausted"),
&yyss1, yysize * sizeof (*yyssp),
&yyvs1, yysize * sizeof (*yyvsp),
&yyls1, yysize * sizeof (*yylsp),
&yystacksize);
yyls = yyls1;
yyss = yyss1;
yyvs = yyvs1;
}
#else /* no yyoverflow */
# ifndef YYSTACK_RELOCATE
goto yyexhaustedlab;
| > | 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 |
conditional around just the two extra args, but that might
be undefined if yyoverflow is a macro. */
yyoverflow (YY_("memory exhausted"),
&yyss1, yysize * sizeof (*yyssp),
&yyvs1, yysize * sizeof (*yyvsp),
&yyls1, yysize * sizeof (*yylsp),
&yystacksize);
yyls = yyls1;
yyss = yyss1;
yyvs = yyvs1;
}
#else /* no yyoverflow */
# ifndef YYSTACK_RELOCATE
goto yyexhaustedlab;
|
| ︙ | ︙ | |||
1481 1482 1483 1484 1485 1486 1487 |
{
yytype_int16 *yyss1 = yyss;
union yyalloc *yyptr =
(union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
if (! yyptr)
goto yyexhaustedlab;
| | | | > > > | | | | | 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 |
{
yytype_int16 *yyss1 = yyss;
union yyalloc *yyptr =
(union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
if (! yyptr)
goto yyexhaustedlab;
YYSTACK_RELOCATE (yyss_alloc, yyss);
YYSTACK_RELOCATE (yyvs_alloc, yyvs);
YYSTACK_RELOCATE (yyls_alloc, yyls);
# undef YYSTACK_RELOCATE
if (yyss1 != yyssa)
YYSTACK_FREE (yyss1);
}
# endif
#endif /* no yyoverflow */
yyssp = yyss + yysize - 1;
yyvsp = yyvs + yysize - 1;
yylsp = yyls + yysize - 1;
YYDPRINTF ((stderr, "Stack size increased to %lu\n",
(unsigned long int) yystacksize));
if (yyss + yystacksize - 1 <= yyssp)
YYABORT;
}
YYDPRINTF ((stderr, "Entering state %d\n", yystate));
if (yystate == YYFINAL)
YYACCEPT;
goto yybackup;
/*-----------.
| yybackup. |
`-----------*/
yybackup:
/* Do appropriate processing given the current state. Read a
lookahead token if we need one and don't already have one. */
/* First try to decide what to do without reference to lookahead token. */
yyn = yypact[yystate];
if (yyn == YYPACT_NINF)
goto yydefault;
/* Not known => get a lookahead token if don't already have one. */
/* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
if (yychar == YYEMPTY)
{
YYDPRINTF ((stderr, "Reading a token: "));
yychar = YYLEX;
}
if (yychar <= YYEOF)
|
| ︙ | ︙ | |||
1553 1554 1555 1556 1557 1558 1559 |
{
if (yyn == 0 || yyn == YYTABLE_NINF)
goto yyerrlab;
yyn = -yyn;
goto yyreduce;
}
| < < < | | < | | 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 |
{
if (yyn == 0 || yyn == YYTABLE_NINF)
goto yyerrlab;
yyn = -yyn;
goto yyreduce;
}
/* Count tokens shifted since error; after three, turn off error
status. */
if (yyerrstatus)
yyerrstatus--;
/* Shift the lookahead token. */
YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
/* Discard the shifted token. */
yychar = YYEMPTY;
yystate = yyn;
*++yyvsp = yylval;
*++yylsp = yylloc;
goto yynewstate;
|
| ︙ | ︙ | |||
1874 1875 1876 1877 1878 1879 1880 |
yyYear = (yyvsp[(3) - (3)].Number);
;}
break;
case 36:
{
| | | | | | 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 |
yyYear = (yyvsp[(3) - (3)].Number);
;}
break;
case 36:
{
yyMonthOrdinalIncr = 1;
yyMonthOrdinal = (yyvsp[(2) - (2)].Number);
;}
break;
case 37:
{
yyMonthOrdinalIncr = (yyvsp[(2) - (3)].Number);
yyMonthOrdinal = (yyvsp[(3) - (3)].Number);
;}
break;
case 38:
{
if ((yyvsp[(2) - (3)].Number) != HOUR( 7)) YYABORT;
|
| ︙ | ︙ | |||
2058 2059 2060 2061 2062 2063 2064 |
{
(yyval.Meridian) = (yyvsp[(1) - (1)].Meridian);
;}
break;
| < | 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 |
{
(yyval.Meridian) = (yyvsp[(1) - (1)].Meridian);
;}
break;
default: break;
}
YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
YYPOPSTACK (yylen);
yylen = 0;
|
| ︙ | ︙ | |||
2135 2136 2137 2138 2139 2140 2141 |
#endif
}
yyerror_range[0] = yylloc;
if (yyerrstatus == 3)
{
| | | | 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 |
#endif
}
yyerror_range[0] = yylloc;
if (yyerrstatus == 3)
{
/* If just tried and failed to reuse lookahead token after an
error, discard it. */
if (yychar <= YYEOF)
{
/* Return failure if at end of input. */
if (yychar == YYEOF)
YYABORT;
}
else
{
yydestruct ("Error: discarding",
yytoken, &yylval, &yylloc, info);
yychar = YYEMPTY;
}
}
/* Else will try to reuse lookahead token after shifting the error
token. */
goto yyerrlab1;
/*---------------------------------------------------.
| yyerrorlab -- error raised explicitly by YYERROR. |
`---------------------------------------------------*/
|
| ︙ | ︙ | |||
2210 2211 2212 2213 2214 2215 2216 |
yydestruct ("Error: popping",
yystos[yystate], yyvsp, yylsp, info);
YYPOPSTACK (1);
yystate = *yyssp;
YY_STACK_PRINT (yyss, yyssp);
}
| < < < | | 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 |
yydestruct ("Error: popping",
yystos[yystate], yyvsp, yylsp, info);
YYPOPSTACK (1);
yystate = *yyssp;
YY_STACK_PRINT (yyss, yyssp);
}
*++yyvsp = yylval;
yyerror_range[1] = yylloc;
/* Using YYLLOC is tempting, but would change the location of
the lookahead. YYLOC is available though. */
YYLLOC_DEFAULT (yyloc, (yyerror_range - 1), 2);
*++yylsp = yyloc;
/* Shift the error token. */
YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);
yystate = yyn;
|
| ︙ | ︙ | |||
2242 2243 2244 2245 2246 2247 2248 | /*-----------------------------------. | yyabortlab -- YYABORT comes here. | `-----------------------------------*/ yyabortlab: yyresult = 1; goto yyreturn; | | | | 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 |
/*-----------------------------------.
| yyabortlab -- YYABORT comes here. |
`-----------------------------------*/
yyabortlab:
yyresult = 1;
goto yyreturn;
#if !defined(yyoverflow) || YYERROR_VERBOSE
/*-------------------------------------------------.
| yyexhaustedlab -- memory exhaustion comes here. |
`-------------------------------------------------*/
yyexhaustedlab:
yyerror (&yylloc, info, YY_("memory exhausted"));
yyresult = 2;
/* Fall through. */
#endif
yyreturn:
if (yychar != YYEMPTY)
yydestruct ("Cleanup: discarding lookahead",
yytoken, &yylval, &yylloc, info);
/* Do not reclaim the symbols of the rule which action triggered
this YYABORT or YYACCEPT. */
YYPOPSTACK (yylen);
YY_STACK_PRINT (yyss, yyssp);
while (yyssp != yyss)
|
| ︙ | ︙ | |||
2509 2510 2511 2512 2513 2514 2515 |
Tcl_IncrRefCount(t);
Tcl_AppendObjToObj(infoPtr->messages, t);
Tcl_DecrRefCount(t);
Tcl_AppendToObj(infoPtr->messages, ")", -1);
infoPtr->separatrix = "\n";
}
| | | | | | 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 |
Tcl_IncrRefCount(t);
Tcl_AppendObjToObj(infoPtr->messages, t);
Tcl_DecrRefCount(t);
Tcl_AppendToObj(infoPtr->messages, ")", -1);
infoPtr->separatrix = "\n";
}
MODULE_SCOPE int
ToSeconds(
int Hours,
int Minutes,
int Seconds,
MERIDIAN Meridian)
{
if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) {
return -1;
}
switch (Meridian) {
case MER24:
|
| ︙ | ︙ | |||
2676 2677 2678 2679 2680 2681 2682 |
register char c;
register char *p;
char buff[20];
int Count;
location->first_column = yyInput - info->dateStart;
for ( ; ; ) {
| | | 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 |
register char c;
register char *p;
char buff[20];
int Count;
location->first_column = yyInput - info->dateStart;
for ( ; ; ) {
while (isspace(UCHAR(*yyInput))) {
yyInput++;
}
if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
/*
* Convert the string into a number; count the number of digits.
*/
|
| ︙ | ︙ | |||
2736 2737 2738 2739 2740 2741 2742 |
Count++;
} else if (c == ')') {
Count--;
}
} while (Count > 0);
}
}
| | | < < | < < < < < < < < < | | < | | < < < < < < | < < < | < < < < < < < < < | | | > | | | | | | | 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 |
Count++;
} else if (c == ')') {
Count--;
}
} while (Count > 0);
}
}
int
TclClockFreeScan(
Tcl_Interp *interp, /* Tcl interpreter */
DateInfo *info) /* Input and result parameters */
{
int status;
/*
* yyInput = stringToParse;
*
* ClockInitDateInfo(info) should be executed to pre-init info;
*/
yyDSTmode = DSTmaybe;
info->messages = Tcl_NewObj();
info->separatrix = "";
Tcl_IncrRefCount(info->messages);
info->dateStart = yyInput;
status = yyparse(info);
if (status == 1) {
Tcl_SetObjResult(interp, info->messages);
Tcl_DecrRefCount(info->messages);
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
return TCL_ERROR;
} else if (status == 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
Tcl_DecrRefCount(info->messages);
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
} else if (status != 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned "
"from date parser. Please "
"report this error as a "
"bug in Tcl.", -1));
Tcl_DecrRefCount(info->messages);
Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
return TCL_ERROR;
}
Tcl_DecrRefCount(info->messages);
if (yyHaveDate > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one date in string", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 |
}
if (yyHaveOrdinalMonth > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one ordinal month in string", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
result = Tcl_NewObj();
resultElement = Tcl_NewObj();
if (yyHaveDate) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyYear));
Tcl_ListObjAppendElement(interp, resultElement,
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 |
}
if (yyHaveOrdinalMonth > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one ordinal month in string", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
int
TclClockOldscanObjCmd(
ClientData clientData, /* Unused */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Count of paraneters */
Tcl_Obj *const *objv) /* Parameters */
{
Tcl_Obj *result, *resultElement;
int yr, mo, da;
DateInfo dateInfo;
DateInfo* info = &dateInfo;
if (objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv,
"stringToParse baseYear baseMonth baseDay" );
return TCL_ERROR;
}
yyInput = Tcl_GetString( objv[1] );
if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK
|| Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK
|| Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) {
return TCL_ERROR;
}
yyYear = yr; yyMonth = mo; yyDay = da;
if (TclClockFreeScan(interp, info) != TCL_OK) {
return TCL_ERROR;
}
result = Tcl_NewObj();
resultElement = Tcl_NewObj();
if (yyHaveDate) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyYear));
Tcl_ListObjAppendElement(interp, resultElement,
|
| ︙ | ︙ | |||
2890 2891 2892 2893 2894 2895 2896 |
Tcl_NewIntObj((int) yyDayNumber));
}
Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
if (yyHaveOrdinalMonth) {
Tcl_ListObjAppendElement(interp, resultElement,
| | | | 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 |
Tcl_NewIntObj((int) yyDayNumber));
}
Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
if (yyHaveOrdinalMonth) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyMonthOrdinalIncr));
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyMonthOrdinal));
}
Tcl_ListObjAppendElement(interp, result, resultElement);
Tcl_SetObjResult(interp, result);
return TCL_OK;
}
|
| ︙ | ︙ |
Added generic/tclDate.h.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 |
/*
* tclDate.h --
*
* This header file handles common usage of clock primitives
* between tclDate.c (yacc), tclClock.c and tclClockFmt.c.
*
* Copyright (c) 2014 Serg G. Brester (aka sebres)
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _TCLCLOCK_H
#define _TCLCLOCK_H
/*
* Constants
*/
#define JULIAN_DAY_POSIX_EPOCH 2440588
#define GREGORIAN_CHANGE_DATE 2361222
#define SECONDS_PER_DAY 86400
#define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \
* SECONDS_PER_DAY)
#define FOUR_CENTURIES 146097 /* days */
#define JDAY_1_JAN_1_CE_JULIAN 1721424
#define JDAY_1_JAN_1_CE_GREGORIAN 1721426
#define ONE_CENTURY_GREGORIAN 36524 /* days */
#define FOUR_YEARS 1461 /* days */
#define ONE_YEAR 365 /* days */
#define RODDENBERRY 1946 /* Another epoch (Hi, Jeff!) */
#define CLF_OPTIONAL (1 << 0) /* token is non mandatory */
#define CLF_POSIXSEC (1 << 1)
#define CLF_LOCALSEC (1 << 2)
#define CLF_JULIANDAY (1 << 3)
#define CLF_TIME (1 << 4)
#define CLF_CENTURY (1 << 6)
#define CLF_DAYOFMONTH (1 << 7)
#define CLF_DAYOFYEAR (1 << 8)
#define CLF_MONTH (1 << 9)
#define CLF_YEAR (1 << 10)
#define CLF_ISO8601YEAR (1 << 12)
#define CLF_ISO8601 (1 << 13)
#define CLF_ISO8601CENTURY (1 << 14)
#define CLF_SIGNED (1 << 15)
/* On demand (lazy) assemble flags */
#define CLF_ASSEMBLE_DATE (1 << 28) /* assemble year, month, etc. using julianDay */
#define CLF_ASSEMBLE_JULIANDAY (1 << 29) /* assemble julianDay using year, month, etc. */
#define CLF_ASSEMBLE_SECONDS (1 << 30) /* assemble localSeconds (and seconds at end) */
#define CLF_DATE (CLF_JULIANDAY | CLF_DAYOFMONTH | CLF_DAYOFYEAR | \
CLF_MONTH | CLF_YEAR | CLF_ISO8601YEAR | CLF_ISO8601)
/*
* Enumeration of the string literals used in [clock]
*/
typedef enum ClockLiteral {
LIT__NIL,
LIT__DEFAULT_FORMAT,
LIT_SYSTEM, LIT_CURRENT, LIT_C,
LIT_BCE, LIT_CE,
LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR,
LIT_ERA, LIT_GMT, LIT_GREGORIAN,
LIT_INTEGER_VALUE_TOO_LARGE,
LIT_ISO8601WEEK, LIT_ISO8601YEAR,
LIT_JULIANDAY, LIT_LOCALSECONDS,
LIT_MONTH,
LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET,
LIT_YEAR,
LIT_TZDATA,
LIT_GETSYSTEMTIMEZONE,
LIT_SETUPTIMEZONE,
LIT_MCGET,
LIT_GETSYSTEMLOCALE, LIT_GETCURRENTLOCALE,
LIT_LOCALIZE_FORMAT,
LIT__END
} ClockLiteral;
#define CLOCK_LITERAL_ARRAY(litarr) static const char *const litarr[] = { \
"", \
"%a %b %d %H:%M:%S %Z %Y", \
"system", "current", "C", \
"BCE", "CE", \
"dayOfMonth", "dayOfWeek", "dayOfYear", \
"era", ":GMT", "gregorian", \
"integer value too large to represent", \
"iso8601Week", "iso8601Year", \
"julianDay", "localSeconds", \
"month", \
"seconds", "tzName", "tzOffset", \
"year", \
"::tcl::clock::TZData", \
"::tcl::clock::GetSystemTimeZone", \
"::tcl::clock::SetupTimeZone", \
"::tcl::clock::mcget", \
"::tcl::clock::GetSystemLocale", "::tcl::clock::mclocale", \
"::tcl::clock::LocalizeFormat" \
}
/*
* Enumeration of the msgcat literals used in [clock]
*/
typedef enum ClockMsgCtLiteral {
MCLIT__NIL, /* placeholder */
MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, MCLIT_MONTHS_COMB,
MCLIT_DAYS_OF_WEEK_FULL, MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_COMB,
MCLIT_AM, MCLIT_PM,
MCLIT_LOCALE_ERAS,
MCLIT_BCE, MCLIT_CE,
MCLIT_BCE2, MCLIT_CE2,
MCLIT_BCE3, MCLIT_CE3,
MCLIT_LOCALE_NUMERALS,
MCLIT__END
} ClockMsgCtLiteral;
#define CLOCK_LOCALE_LITERAL_ARRAY(litarr, pref) static const char *const litarr[] = { \
pref "", \
pref "MONTHS_FULL", pref "MONTHS_ABBREV", pref "MONTHS_COMB", \
pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", pref "DAYS_OF_WEEK_COMB", \
pref "AM", pref "PM", \
pref "LOCALE_ERAS", \
pref "BCE", pref "CE", \
pref "b.c.e.", pref "c.e.", \
pref "b.c.", pref "a.d.", \
pref "LOCALE_NUMERALS", \
}
/*
* Structure containing the fields used in [clock format] and [clock scan]
*/
typedef struct TclDateFields {
/* Cacheable fields: */
Tcl_WideInt seconds; /* Time expressed in seconds from the Posix
* epoch */
Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds
* from the Posix epoch */
int tzOffset; /* Time zone offset in seconds east of
* Greenwich */
int julianDay; /* Julian Day Number in local time zone */
enum {BCE=1, CE=0} era; /* Era */
int gregorian; /* Flag == 1 if the date is Gregorian */
int year; /* Year of the era */
int dayOfYear; /* Day of the year (1 January == 1) */
int month; /* Month number */
int dayOfMonth; /* Day of the month */
int iso8601Year; /* ISO8601 week-based year */
int iso8601Week; /* ISO8601 week number */
int dayOfWeek; /* Day of the week */
int hour; /* Hours of day (in-between time only calculation) */
int minutes; /* Minutes of day (in-between time only calculation) */
int secondOfDay; /* Seconds of day (in-between time only calculation) */
/* Non cacheable fields: */
Tcl_Obj *tzName; /* Name (or corresponding DST-abbreviation) of the
* time zone, if set the refCount is incremented */
} TclDateFields;
#define ClockCacheableDateFieldsSize \
TclOffset(TclDateFields, tzName)
/*
* Structure contains return parsed fields.
*/
typedef struct DateInfo {
const char *dateStart;
const char *dateInput;
const char *dateEnd;
TclDateFields date;
int flags;
int dateHaveDate;
int dateMeridian;
int dateHaveTime;
int dateTimezone;
int dateDSTmode;
int dateHaveZone;
int dateRelMonth;
int dateRelDay;
int dateRelSeconds;
int dateHaveRel;
int dateMonthOrdinalIncr;
int dateMonthOrdinal;
int dateHaveOrdinalMonth;
int dateDayOrdinal;
int dateDayNumber;
int dateHaveDay;
int *dateRelPointer;
int dateSpaceCount;
int dateDigitCount;
int dateCentury;
Tcl_Obj* messages; /* Error messages */
const char* separatrix; /* String separating messages */
} DateInfo;
#define yydate (info->date) /* Date fields used for converting */
#define yyDay (info->date.dayOfMonth)
#define yyMonth (info->date.month)
#define yyYear (info->date.year)
#define yyHour (info->date.hour)
#define yyMinutes (info->date.minutes)
#define yySeconds (info->date.secondOfDay)
#define yyDSTmode (info->dateDSTmode)
#define yyDayOrdinal (info->dateDayOrdinal)
#define yyDayNumber (info->dateDayNumber)
#define yyMonthOrdinalIncr (info->dateMonthOrdinalIncr)
#define yyMonthOrdinal (info->dateMonthOrdinal)
#define yyHaveDate (info->dateHaveDate)
#define yyHaveDay (info->dateHaveDay)
#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth)
#define yyHaveRel (info->dateHaveRel)
#define yyHaveTime (info->dateHaveTime)
#define yyHaveZone (info->dateHaveZone)
#define yyTimezone (info->dateTimezone)
#define yyMeridian (info->dateMeridian)
#define yyRelMonth (info->dateRelMonth)
#define yyRelDay (info->dateRelDay)
#define yyRelSeconds (info->dateRelSeconds)
#define yyRelPointer (info->dateRelPointer)
#define yyInput (info->dateInput)
#define yyDigitCount (info->dateDigitCount)
#define yySpaceCount (info->dateSpaceCount)
static inline void
ClockInitDateInfo(DateInfo *info) {
memset(info, 0, sizeof(DateInfo));
}
/*
* Structure containing the command arguments supplied to [clock format] and [clock scan]
*/
#define CLF_EXTENDED (1 << 4)
#define CLF_STRICT (1 << 8)
#define CLF_LOCALE_USED (1 << 15)
typedef struct ClockFmtScnCmdArgs {
ClientData clientData; /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp; /* Tcl interpreter */
Tcl_Obj *formatObj; /* Format */
Tcl_Obj *localeObj; /* Name of the locale where the time will be expressed. */
Tcl_Obj *timezoneObj; /* Default time zone in which the time will be expressed */
Tcl_Obj *baseObj; /* Base (scan and add) or clockValue (format) */
int flags; /* Flags control scanning */
Tcl_Obj *mcDictObj; /* Current dictionary of tcl::clock package for given localeObj*/
} ClockFmtScnCmdArgs;
/*
* Structure containing the client data for [clock]
*/
typedef struct ClockClientData {
size_t refCount; /* Number of live references. */
Tcl_Obj **literals; /* Pool of object literals (common, locale independent). */
Tcl_Obj **mcLiterals; /* Msgcat object literals with mc-keys for search with locale. */
Tcl_Obj **mcLitIdxs; /* Msgcat object indices prefixed with _IDX_,
* used for quick dictionary search */
/* Cache for current clock parameters, imparted via "configure" */
unsigned long LastTZEpoch;
int currentYearCentury;
int yearOfCenturySwitch;
Tcl_Obj *SystemTimeZone;
Tcl_Obj *SystemSetupTZData;
Tcl_Obj *GMTSetupTimeZone;
Tcl_Obj *GMTSetupTZData;
Tcl_Obj *AnySetupTimeZone;
Tcl_Obj *AnySetupTZData;
Tcl_Obj *LastUnnormSetupTimeZone;
Tcl_Obj *LastSetupTimeZone;
Tcl_Obj *LastSetupTZData;
Tcl_Obj *CurrentLocale;
Tcl_Obj *CurrentLocaleDict;
Tcl_Obj *LastUnnormUsedLocale;
Tcl_Obj *LastUsedLocale;
Tcl_Obj *LastUsedLocaleDict;
/* Cache for last base (last-second fast convert if base/tz not changed) */
struct {
Tcl_Obj *timezoneObj;
TclDateFields Date;
} lastBase;
/* Las-period cache for fast UTC2Local conversion */
struct {
/* keys */
Tcl_Obj *timezoneObj;
int changeover;
Tcl_WideInt seconds;
Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */
/* values */
int tzOffset;
Tcl_Obj *tzName;
} UTC2Local;
/* Las-period cache for fast Local2UTC conversion */
struct {
/* keys */
Tcl_Obj *timezoneObj;
int changeover;
Tcl_WideInt localSeconds;
Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */
/* values */
int tzOffset;
} Local2UTC;
} ClockClientData;
#define ClockDefaultYearCentury 2000
#define ClockDefaultCenturySwitch 38
/*
* Meridian: am, pm, or 24-hour style.
*/
typedef enum _MERIDIAN {
MERam, MERpm, MER24
} MERIDIAN;
/*
* Clock scan and format facilities.
*/
#define CLOCK_FMT_SCN_STORAGE_GC_SIZE 32
#define CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE 2
typedef struct ClockScanToken ClockScanToken;
typedef int ClockScanTokenProc(
ClockFmtScnCmdArgs *opts,
DateInfo *info,
ClockScanToken *tok);
typedef enum _CLCKTOK_TYPE {
CTOKT_DIGIT = 1, CTOKT_PARSER, CTOKT_SPACE, CTOKT_WORD, CTOKT_CHAR,
CFMTT_INT, CFMTT_WIDE, CFMTT_PROC
} CLCKTOK_TYPE;
typedef struct ClockScanTokenMap {
unsigned short int type;
unsigned short int flags;
unsigned short int clearFlags;
unsigned short int minSize;
unsigned short int maxSize;
unsigned short int offs;
ClockScanTokenProc *parser;
const void *data;
} ClockScanTokenMap;
typedef struct ClockScanToken {
ClockScanTokenMap *map;
struct {
const char *start;
const char *end;
} tokWord;
unsigned short int endDistance;
unsigned short int lookAhMin;
unsigned short int lookAhMax;
unsigned short int lookAhTok;
} ClockScanToken;
#define MIN_FMT_RESULT_BLOCK_ALLOC 200
typedef struct DateFormat {
char *resMem;
char *resEnd;
char *output;
TclDateFields date;
Tcl_Obj *localeEra;
} DateFormat;
#define CLFMT_INCR (1 << 3)
#define CLFMT_DECR (1 << 4)
#define CLFMT_CALC (1 << 5)
#define CLFMT_LOCALE_INDX (1 << 8)
typedef struct ClockFormatToken ClockFormatToken;
typedef int ClockFormatTokenProc(
ClockFmtScnCmdArgs *opts,
DateFormat *dateFmt,
ClockFormatToken *tok,
int *val);
typedef struct ClockFormatTokenMap {
unsigned short int type;
const char *tostr;
unsigned short int width;
unsigned short int flags;
unsigned short int divider;
unsigned short int divmod;
unsigned short int offs;
ClockFormatTokenProc *fmtproc;
void *data;
} ClockFormatTokenMap;
typedef struct ClockFormatToken {
ClockFormatTokenMap *map;
struct {
const char *start;
const char *end;
} tokWord;
} ClockFormatToken;
typedef struct ClockFmtScnStorage ClockFmtScnStorage;
typedef struct ClockFmtScnStorage {
int objRefCount; /* Reference count shared across threads */
ClockScanToken *scnTok;
unsigned int scnTokC;
unsigned int scnSpaceCount; /* Count of mandatory spaces used in format */
ClockFormatToken *fmtTok;
unsigned int fmtTokC;
#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
ClockFmtScnStorage *nextPtr;
ClockFmtScnStorage *prevPtr;
#endif
#if 0
+Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of Tcl_HashEntry,
* stored by offset +sizeof(self) */
#endif
} ClockFmtScnStorage;
/*
* Prototypes of module functions.
*/
MODULE_SCOPE int ToSeconds(int Hours, int Minutes,
int Seconds, MERIDIAN Meridian);
MODULE_SCOPE int IsGregorianLeapYear(TclDateFields *);
MODULE_SCOPE void
GetJulianDayFromEraYearWeekDay(
TclDateFields *fields, int changeover);
MODULE_SCOPE void
GetJulianDayFromEraYearMonthDay(
TclDateFields *fields, int changeover);
MODULE_SCOPE void
GetJulianDayFromEraYearDay(
TclDateFields *fields, int changeover);
MODULE_SCOPE int ConvertUTCToLocal(ClientData clientData, Tcl_Interp *,
TclDateFields *, Tcl_Obj *timezoneObj, int);
MODULE_SCOPE Tcl_Obj *
LookupLastTransition(Tcl_Interp *, Tcl_WideInt,
int, Tcl_Obj *const *, Tcl_WideInt rangesVal[2]);
MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info);
/* tclClock.c module declarations */
MODULE_SCOPE Tcl_Obj *
ClockSetupTimeZone(ClientData clientData,
Tcl_Interp *interp, Tcl_Obj *timezoneObj);
MODULE_SCOPE Tcl_Obj *
ClockMCDict(ClockFmtScnCmdArgs *opts);
MODULE_SCOPE Tcl_Obj *
ClockMCGet(ClockFmtScnCmdArgs *opts, int mcKey);
MODULE_SCOPE Tcl_Obj *
ClockMCGetIdx(ClockFmtScnCmdArgs *opts, int mcKey);
MODULE_SCOPE int ClockMCSetIdx(ClockFmtScnCmdArgs *opts, int mcKey,
Tcl_Obj *valObj);
/* tclClockFmt.c module declarations */
MODULE_SCOPE Tcl_Obj*
ClockFrmObjGetLocFmtKey(Tcl_Interp *interp,
Tcl_Obj *objPtr);
MODULE_SCOPE ClockFmtScnStorage *
Tcl_GetClockFrmScnFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
MODULE_SCOPE Tcl_Obj *
ClockLocalizeFormat(ClockFmtScnCmdArgs *opts);
MODULE_SCOPE int ClockScan(register DateInfo *info,
Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts);
MODULE_SCOPE int ClockFormat(register DateFormat *dateFmt,
ClockFmtScnCmdArgs *opts);
MODULE_SCOPE void ClockFrmScnClearCaches(void);
#endif /* _TCLCLOCK_H */
|
Changes to generic/tclDictObj.c.
| ︙ | ︙ | |||
47 48 49 50 51 52 53 54 55 56 57 58 59 60 | int objc, Tcl_Obj *const *objv); static int DictReplaceCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictSetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictSizeCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictUnsetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictUpdateCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictValuesCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictWithCmd(ClientData dummy, Tcl_Interp *interp, | > > | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 | int objc, Tcl_Obj *const *objv); static int DictReplaceCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictSetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictSizeCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictSmartRefCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictUnsetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictUpdateCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictValuesCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictWithCmd(ClientData dummy, Tcl_Interp *interp, |
| ︙ | ︙ | |||
94 95 96 97 98 99 100 101 102 103 104 105 106 107 |
{"lappend", DictLappendCmd, TclCompileDictLappendCmd, NULL, NULL, 0 },
{"map", NULL, TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 },
{"merge", DictMergeCmd, TclCompileDictMergeCmd, NULL, NULL, 0 },
{"remove", DictRemoveCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
{"replace", DictReplaceCmd, NULL, NULL, NULL, 0 },
{"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 },
{"size", DictSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
{"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 },
{"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 },
{"values", DictValuesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
{"with", DictWithCmd, TclCompileDictWithCmd, NULL, NULL, 0 },
{NULL, NULL, NULL, NULL, NULL, 0}
};
| > | 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 |
{"lappend", DictLappendCmd, TclCompileDictLappendCmd, NULL, NULL, 0 },
{"map", NULL, TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 },
{"merge", DictMergeCmd, TclCompileDictMergeCmd, NULL, NULL, 0 },
{"remove", DictRemoveCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
{"replace", DictReplaceCmd, NULL, NULL, NULL, 0 },
{"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 },
{"size", DictSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
{"smartref",DictSmartRefCmd,NULL, NULL, NULL, 0 },
{"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 },
{"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 },
{"values", DictValuesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
{"with", DictWithCmd, TclCompileDictWithCmd, NULL, NULL, 0 },
{NULL, NULL, NULL, NULL, NULL, 0}
};
|
| ︙ | ︙ | |||
1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 |
}
result = Tcl_DictObjSize(interp, objv[1], &size);
if (result == TCL_OK) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
}
return result;
}
/*
*----------------------------------------------------------------------
*
* DictExistsCmd --
*
* This function implements the "dict exists" Tcl command. See the user
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 |
}
result = Tcl_DictObjSize(interp, objv[1], &size);
if (result == TCL_OK) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
}
return result;
}
/*
*----------------------------------------------------------------------
*
* Tcl_DictObjSmartRef --
*
* This function returns new tcl-object with the smart reference to
* dictionary object.
*
* Object returned with this function is a smart reference (pointer),
* so new object of type tclDictType, that directly references given
* dictionary object (with internally increased refCount).
*
* The usage of such pointer objects allows to hold more as one
* reference to the same real dictionary object, allows to make a pointer
* to part of another dictionary, allows to change the dictionary without
* regarding of the "shared" state of the dictionary object.
*
* Prevents "called with shared object" exception if object is multiple
* referenced.
*
* Results:
* The newly create object (contains smart reference) is returned.
* The returned object has a ref count of 0.
*
* Side effects:
* Increases ref count of the referenced dictionary.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_DictObjSmartRef(
Tcl_Interp *interp,
Tcl_Obj *dictPtr)
{
Tcl_Obj *result;
Dict *dict;
if (dictPtr->typePtr != &tclDictType
&& SetDictFromAny(interp, dictPtr) != TCL_OK) {
return NULL;
}
dict = DICT(dictPtr);
result = Tcl_NewObj();
DICT(result) = dict;
dict->refCount++;
result->internalRep.twoPtrValue.ptr2 = NULL;
result->typePtr = &tclDictType;
return result;
}
/*
*----------------------------------------------------------------------
*
* DictSmartRefCmd --
*
* This function implements the "dict smartref" Tcl command.
*
* See description of Tcl_DictObjSmartRef for details.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictSmartRefCmd(
ClientData dummy,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *result;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
return TCL_ERROR;
}
result = Tcl_DictObjSmartRef(interp, objv[1]);
if (result == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, result);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* DictExistsCmd --
*
* This function implements the "dict exists" Tcl command. See the user
|
| ︙ | ︙ |
Changes to generic/tclEnsemble.c.
| ︙ | ︙ | |||
51 52 53 54 55 56 57 |
"configure", "create", "exists", NULL
};
enum EnsSubcmds {
ENS_CONFIG, ENS_CREATE, ENS_EXISTS
};
static const char *const ensembleCreateOptions[] = {
| | | > | | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 |
"configure", "create", "exists", NULL
};
enum EnsSubcmds {
ENS_CONFIG, ENS_CREATE, ENS_EXISTS
};
static const char *const ensembleCreateOptions[] = {
"-command", "-compile", "-map", "-parameters", "-prefixes",
"-subcommands", "-unknown", NULL
};
enum EnsCreateOpts {
CRT_CMD, CRT_COMPILE, CRT_MAP, CRT_PARAM, CRT_PREFIX,
CRT_SUBCMDS, CRT_UNKNOWN
};
static const char *const ensembleConfigOptions[] = {
"-map", "-namespace", "-parameters", "-prefixes", "-subcommands",
"-unknown", NULL
};
enum EnsConfigOpts {
|
| ︙ | ︙ | |||
179 180 181 182 183 184 185 186 187 188 189 190 191 192 |
* Defaults
*/
Tcl_Obj *subcmdObj = NULL;
Tcl_Obj *mapObj = NULL;
int permitPrefix = 1;
Tcl_Obj *unknownObj = NULL;
Tcl_Obj *paramObj = NULL;
/*
* Check that we've got option-value pairs... [Bug 1558654]
*/
if (objc & 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?option value ...?");
| > | 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 |
* Defaults
*/
Tcl_Obj *subcmdObj = NULL;
Tcl_Obj *mapObj = NULL;
int permitPrefix = 1;
Tcl_Obj *unknownObj = NULL;
Tcl_Obj *paramObj = NULL;
int ensCompFlag = -1;
/*
* Check that we've got option-value pairs... [Bug 1558654]
*/
if (objc & 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?option value ...?");
|
| ︙ | ︙ | |||
320 321 322 323 324 325 326 327 328 329 330 331 332 333 |
if (Tcl_GetBooleanFromObj(interp, objv[1],
&permitPrefix) != TCL_OK) {
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
}
return TCL_ERROR;
}
continue;
case CRT_UNKNOWN:
if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
}
return TCL_ERROR;
| > > > > > > | 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 |
if (Tcl_GetBooleanFromObj(interp, objv[1],
&permitPrefix) != TCL_OK) {
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
}
return TCL_ERROR;
}
continue;
case CRT_COMPILE:
if (Tcl_GetBooleanFromObj(interp, objv[1],
&ensCompFlag) != TCL_OK) {
return TCL_ERROR;
};
continue;
case CRT_UNKNOWN:
if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
}
return TCL_ERROR;
|
| ︙ | ︙ | |||
346 347 348 349 350 351 352 353 354 355 356 357 358 359 | token = Tcl_CreateEnsemble(interp, name, NULL, (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0)); Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj); Tcl_SetEnsembleMappingDict(interp, token, mapObj); Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj); Tcl_SetEnsembleParameterList(interp, token, paramObj); /* * Tricky! Must ensure that the result is not shared (command delete * traces could have corrupted the pristine object that we started * with). [Snit test rename-1.5] */ | > > > > > > | 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 |
token = Tcl_CreateEnsemble(interp, name, NULL,
(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
Tcl_SetEnsembleParameterList(interp, token, paramObj);
/*
* Ensemble should be compiled if it has map (performance purposes)
*/
if (ensCompFlag > 0 && mapObj != NULL) {
Tcl_SetEnsembleFlags(interp, token, ENSEMBLE_COMPILE);
}
/*
* Tricky! Must ensure that the result is not shared (command delete
* traces could have corrupted the pristine object that we started
* with). [Snit test rename-1.5]
*/
|
| ︙ | ︙ |
Changes to generic/tclEnv.c.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */
static struct {
int cacheSize; /* Number of env strings in cache. */
char **cache; /* Array containing all of the environment
* strings that Tcl has allocated. */
#ifndef USE_PUTENV
char **ourEnviron; /* Cache of the array that we allocate. We
* need to track this in case another
| > > > > > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 |
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */
/* MODULE_SCOPE */
size_t TclEnvEpoch = 0; /* Epoch of the tcl environment
* (if changed with tcl-env). */
static struct {
int cacheSize; /* Number of env strings in cache. */
char **cache; /* Array containing all of the environment
* strings that Tcl has allocated. */
#ifndef USE_PUTENV
char **ourEnviron; /* Cache of the array that we allocate. We
* need to track this in case another
|
| ︙ | ︙ | |||
367 368 369 370 371 372 373 374 375 376 377 378 379 380 |
name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString);
value = strchr(name, '=');
if ((value != NULL) && (value != name)) {
value[0] = '\0';
TclSetEnv(name, value+1);
}
Tcl_DStringFree(&nameString);
return 0;
}
/*
*----------------------------------------------------------------------
| > | 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 |
name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString);
value = strchr(name, '=');
if ((value != NULL) && (value != name)) {
value[0] = '\0';
TclSetEnv(name, value+1);
}
TclEnvEpoch++;
Tcl_DStringFree(&nameString);
return 0;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 |
{
/*
* For array traces, let TclSetupEnv do all the work.
*/
if (flags & TCL_TRACE_ARRAY) {
TclSetupEnv(interp);
return NULL;
}
/*
* If name2 is NULL, then return and do nothing.
*/
if (name2 == NULL) {
return NULL;
}
/*
* If a value is being set, call TclSetEnv to do all of the work.
*/
if (flags & TCL_TRACE_WRITES) {
const char *value;
value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
TclSetEnv(name2, value);
}
/*
* If a value is being read, call TclGetEnv to do all of the work.
*/
if (flags & TCL_TRACE_READS) {
| > > | 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 |
{
/*
* For array traces, let TclSetupEnv do all the work.
*/
if (flags & TCL_TRACE_ARRAY) {
TclSetupEnv(interp);
TclEnvEpoch++;
return NULL;
}
/*
* If name2 is NULL, then return and do nothing.
*/
if (name2 == NULL) {
return NULL;
}
/*
* If a value is being set, call TclSetEnv to do all of the work.
*/
if (flags & TCL_TRACE_WRITES) {
const char *value;
value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
TclSetEnv(name2, value);
TclEnvEpoch++;
}
/*
* If a value is being read, call TclGetEnv to do all of the work.
*/
if (flags & TCL_TRACE_READS) {
|
| ︙ | ︙ | |||
618 619 620 621 622 623 624 625 626 627 628 629 630 631 |
/*
* For unset traces, let TclUnsetEnv do all the work.
*/
if (flags & TCL_TRACE_UNSETS) {
TclUnsetEnv(name2);
}
return NULL;
}
/*
*----------------------------------------------------------------------
*
| > | 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 |
/*
* For unset traces, let TclUnsetEnv do all the work.
*/
if (flags & TCL_TRACE_UNSETS) {
TclUnsetEnv(name2);
TclEnvEpoch++;
}
return NULL;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ |
Changes to generic/tclExecute.c.
| ︙ | ︙ | |||
2681 2682 2683 2684 2685 2686 2687 2688 |
NEXT_INST_F(5, 0, 0);
}
case INST_STR_CONCAT1:
opnd = TclGetUInt1AtPtr(pc+1);
if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
| > > > > > > > > > > > > > > > > > > > > > > | > | 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 |
NEXT_INST_F(5, 0, 0);
}
case INST_STR_CONCAT1:
opnd = TclGetUInt1AtPtr(pc+1);
objv = &OBJ_AT_DEPTH(opnd-1);
/* minor optimization in simplest cases */
switch (opnd) {
case 1: /* only one object */
objResultPtr = *objv;
goto endINST_STR_CONCAT1;
case 2: /* two objects - check empty */
if (objv[0]->bytes == &tclEmptyString) {
objResultPtr = objv[1];
goto endINST_STR_CONCAT1;
}
else
if (objv[1]->bytes == &tclEmptyString) {
objResultPtr = objv[0];
goto endINST_STR_CONCAT1;
}
break;
case 0: /* no objects - use new empty */
TclNewObj(objResultPtr);
goto endINST_STR_CONCAT1;
}
/* do concat */
if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
opnd, objv, &objResultPtr)) {
TRACE_ERROR(interp);
goto gotError;
}
endINST_STR_CONCAT1:
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_V(2, opnd, 1);
case INST_CONCAT_STK:
/*
* Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,
|
| ︙ | ︙ |
Changes to generic/tclGetDate.y.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
/*
* tclGetDate.y --
*
* Contains yacc grammar for parsing date and time strings. The output of
* this file should be the file tclDate.c which is used directly in the
* Tcl sources. Note that this file is largely obsolete in Tcl 8.5; it is
* only used when doing free-form date parsing, an ill-defined process
* anyway.
*
* Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
%parse-param {DateInfo* info}
%lex-param {DateInfo* info}
| > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
/*
* tclGetDate.y --
*
* Contains yacc grammar for parsing date and time strings. The output of
* this file should be the file tclDate.c which is used directly in the
* Tcl sources. Note that this file is largely obsolete in Tcl 8.5; it is
* only used when doing free-form date parsing, an ill-defined process
* anyway.
*
* Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
* Copyright (c) 2015 Sergey G. Brester aka sebres.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
%parse-param {DateInfo* info}
%lex-param {DateInfo* info}
|
| ︙ | ︙ | |||
46 47 48 49 50 51 52 | #endif /* _MSC_VER */ /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ | < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | #endif /* _MSC_VER */ /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ #include "tclDate.h" #define YYMALLOC ckalloc #define YYFREE(x) (ckfree((void*) (x))) #define EPOCH 1970 #define START_OF_TIME 1902 #define END_OF_TIME 2037 /* * The offset of tm_year of struct tm returned by localtime, gmtime, etc. * Posix requires 1900. |
| ︙ | ︙ | |||
146 147 148 149 150 151 152 |
* Daylight-savings mode: on, off, or not yet known.
*/
typedef enum _DSTMODE {
DSTon, DSToff, DSTmaybe
} DSTMODE;
| < < < < < < < < < < | 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 |
* Daylight-savings mode: on, off, or not yet known.
*/
typedef enum _DSTMODE {
DSTon, DSToff, DSTmaybe
} DSTMODE;
%}
%union {
time_t Number;
enum _MERIDIAN Meridian;
}
%{
/*
* Prototypes of internal functions.
*/
static int LookupWord(YYSTYPE* yylvalPtr, char *buff);
static void TclDateerror(YYLTYPE* location,
DateInfo* info, const char *s);
static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location,
DateInfo* info);
MODULE_SCOPE int yyparse(DateInfo*);
%}
%token tAGO
%token tDAY
%token tDAYZONE
|
| ︙ | ︙ | |||
373 374 375 376 377 378 379 |
yyMonth = $2;
yyDay = $1;
yyYear = $3;
}
;
ordMonth: tNEXT tMONTH {
| | | | | | 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 |
yyMonth = $2;
yyDay = $1;
yyYear = $3;
}
;
ordMonth: tNEXT tMONTH {
yyMonthOrdinalIncr = 1;
yyMonthOrdinal = $2;
}
| tNEXT tUNUMBER tMONTH {
yyMonthOrdinalIncr = $2;
yyMonthOrdinal = $3;
}
;
iso : tISOBASE tZONE tISOBASE {
if ($2 != HOUR( 7)) YYABORT;
yyYear = $1 / 10000;
yyMonth = ($1 % 10000)/100;
|
| ︙ | ︙ | |||
726 727 728 729 730 731 732 |
Tcl_IncrRefCount(t);
Tcl_AppendObjToObj(infoPtr->messages, t);
Tcl_DecrRefCount(t);
Tcl_AppendToObj(infoPtr->messages, ")", -1);
infoPtr->separatrix = "\n";
}
| | | | | | 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 |
Tcl_IncrRefCount(t);
Tcl_AppendObjToObj(infoPtr->messages, t);
Tcl_DecrRefCount(t);
Tcl_AppendToObj(infoPtr->messages, ")", -1);
infoPtr->separatrix = "\n";
}
MODULE_SCOPE int
ToSeconds(
int Hours,
int Minutes,
int Seconds,
MERIDIAN Meridian)
{
if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) {
return -1;
}
switch (Meridian) {
case MER24:
|
| ︙ | ︙ | |||
953 954 955 956 957 958 959 |
Count++;
} else if (c == ')') {
Count--;
}
} while (Count > 0);
}
}
| | | < < | < < < < < < < < < | | < | | < < < < < < | < < < | < < < < < < < < < | | | > | | | | | | | 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 |
Count++;
} else if (c == ')') {
Count--;
}
} while (Count > 0);
}
}
int
TclClockFreeScan(
Tcl_Interp *interp, /* Tcl interpreter */
DateInfo *info) /* Input and result parameters */
{
int status;
/*
* yyInput = stringToParse;
*
* ClockInitDateInfo(info) should be executed to pre-init info;
*/
yyDSTmode = DSTmaybe;
info->messages = Tcl_NewObj();
info->separatrix = "";
Tcl_IncrRefCount(info->messages);
info->dateStart = yyInput;
status = yyparse(info);
if (status == 1) {
Tcl_SetObjResult(interp, info->messages);
Tcl_DecrRefCount(info->messages);
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
return TCL_ERROR;
} else if (status == 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
Tcl_DecrRefCount(info->messages);
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
} else if (status != 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned "
"from date parser. Please "
"report this error as a "
"bug in Tcl.", -1));
Tcl_DecrRefCount(info->messages);
Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
return TCL_ERROR;
}
Tcl_DecrRefCount(info->messages);
if (yyHaveDate > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one date in string", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 |
}
if (yyHaveOrdinalMonth > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one ordinal month in string", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
result = Tcl_NewObj();
resultElement = Tcl_NewObj();
if (yyHaveDate) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyYear));
Tcl_ListObjAppendElement(interp, resultElement,
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 |
}
if (yyHaveOrdinalMonth > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one ordinal month in string", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
int
TclClockOldscanObjCmd(
ClientData clientData, /* Unused */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Count of paraneters */
Tcl_Obj *const *objv) /* Parameters */
{
Tcl_Obj *result, *resultElement;
int yr, mo, da;
DateInfo dateInfo;
DateInfo* info = &dateInfo;
if (objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv,
"stringToParse baseYear baseMonth baseDay" );
return TCL_ERROR;
}
yyInput = Tcl_GetString( objv[1] );
if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK
|| Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK
|| Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) {
return TCL_ERROR;
}
yyYear = yr; yyMonth = mo; yyDay = da;
if (TclClockFreeScan(interp, info) != TCL_OK) {
return TCL_ERROR;
}
result = Tcl_NewObj();
resultElement = Tcl_NewObj();
if (yyHaveDate) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyYear));
Tcl_ListObjAppendElement(interp, resultElement,
|
| ︙ | ︙ | |||
1107 1108 1109 1110 1111 1112 1113 |
Tcl_NewIntObj((int) yyDayNumber));
}
Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
if (yyHaveOrdinalMonth) {
Tcl_ListObjAppendElement(interp, resultElement,
| | | | 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 |
Tcl_NewIntObj((int) yyDayNumber));
}
Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
if (yyHaveOrdinalMonth) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyMonthOrdinalIncr));
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyMonthOrdinal));
}
Tcl_ListObjAppendElement(interp, result, resultElement);
Tcl_SetObjResult(interp, result);
return TCL_OK;
}
|
| ︙ | ︙ |
Changes to generic/tclInt.h.
| ︙ | ︙ | |||
2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 | MODULE_SCOPE int TclConvertElement(const char *src, int length, char *dst, int flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, int dictLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *literalPtr); /* TIP #280 - Modified token based evulation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags, int line, int *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd; | > | 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 | MODULE_SCOPE int TclConvertElement(const char *src, int length, char *dst, int flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, int dictLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *literalPtr); MODULE_SCOPE Tcl_Obj * Tcl_DictObjSmartRef(Tcl_Interp *interp, Tcl_Obj *); /* TIP #280 - Modified token based evulation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags, int line, int *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd; |
| ︙ | ︙ | |||
3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 | MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer, int size, int codeSize, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); #endif MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); #ifdef TCL_WIDE_CLICKS MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); #endif MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); MODULE_SCOPE void * TclpThreadCreateKey(void); MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr); MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr); MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length); | > > > > > > > > > > > > | 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 | MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer, int size, int codeSize, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); #endif MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); #ifdef TCL_WIDE_CLICKS MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); MODULE_SCOPE double TclpWideClickInMicrosec(void); #else # ifdef _WIN32 # define TCL_WIDE_CLICKS 1 MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClickInMicrosec(void); # define TclpWideClicksToNanoseconds(clicks) \ ((double)(clicks) * TclpWideClickInMicrosec() * 1000) # endif #endif MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void); MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); MODULE_SCOPE void * TclpThreadCreateKey(void); MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr); MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr); MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length); |
| ︙ | ︙ | |||
3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 | MODULE_SCOPE int Tcl_TellObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TryObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); | > > > | 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 | MODULE_SCOPE int Tcl_TellObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TimeRateObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TryObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); |
| ︙ | ︙ | |||
4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 | #if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG) #define Tcl_AttemptAlloc(size) TclpAlloc(size) #define Tcl_AttemptRealloc(ptr, size) TclpRealloc((ptr), (size)) #define Tcl_Free(ptr) TclpFree(ptr) #endif #endif /* _TCLINT */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ | > > > > > > > | 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 |
#if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG)
#define Tcl_AttemptAlloc(size) TclpAlloc(size)
#define Tcl_AttemptRealloc(ptr, size) TclpRealloc((ptr), (size))
#define Tcl_Free(ptr) TclpFree(ptr)
#endif
/*
* Other externals.
*/
MODULE_SCOPE size_t TclEnvEpoch; /* Epoch of the tcl environment
* (if changed with tcl-env). */
#endif /* _TCLINT */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Added generic/tclStrIdxTree.c.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 |
/*
* tclStrIdxTree.c --
*
* Contains the routines for managing string index tries in Tcl.
*
* This code is back-ported from the tclSE engine, by Serg G. Brester.
*
* Copyright (c) 2016 by Sergey G. Brester aka sebres. All rights reserved.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* -----------------------------------------------------------------------
*
* String index tries are prepaired structures used for fast greedy search of the string
* (index) by unique string prefix as key.
*
* Index tree build for two lists together can be explained in the following datagram
*
* Lists:
*
* {Januar Februar Maerz April Mai Juni Juli August September Oktober November Dezember}
* {Jnr Fbr Mrz Apr Mai Jni Jli Agt Spt Okt Nvb Dzb}
*
* Index-Tree:
*
* j 0 * ...
* anuar 1 *
* u 0 * a 0
* ni 6 * pril 4
* li 7 * ugust 8
* n 0 * gt 8
* r 1 * s 9
* i 6 * eptember 9
* li 7 * pt 9
* f 2 * oktober 10
* ebruar 2 * n 11
* br 2 * ovember 11
* m 0 * vb 11
* a 0 * d 12
* erz 3 * ezember 12
* i 5 * zb 12
* rz 3 *
* ...
*
* Thereby value 0 shows pure group items (corresponding ambigous matches).
* But the group may have a value if it contains only same values
* (see for example group "f" above).
*
* StrIdxTree's are very fast, so:
* build of above-mentioned tree takes about 10 microseconds.
* search of string index in this tree takes fewer as 0.1 microseconds.
*
*/
#include "tclInt.h"
#include "tclStrIdxTree.h"
/*
*----------------------------------------------------------------------
*
* TclStrIdxTreeSearch --
*
* Find largest part of string "start" in indexed tree (case sensitive).
*
* Also used for building of string index tree.
*
* Results:
* Return position of UTF character in start after last equal character
* and found item (with parent).
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE const char*
TclStrIdxTreeSearch(
TclStrIdxTree **foundParent, /* Return value of found sub tree (used for tree build) */
TclStrIdx **foundItem, /* Return value of found item */
TclStrIdxTree *tree, /* Index tree will be browsed */
const char *start, /* UTF string to find in tree */
const char *end) /* End of string */
{
TclStrIdxTree *parent = tree, *prevParent = tree;
TclStrIdx *item = tree->firstPtr, *prevItem = NULL;
const char *s = start, *f, *cin, *cinf, *prevf;
int offs = 0;
if (item == NULL) {
goto done;
}
/* search in tree */
do {
cinf = cin = TclGetString(item->key) + offs;
f = TclUtfFindEqualNCInLwr(s, end, cin, cin + item->length, &cinf);
/* if something was found */
if (f > s) {
/* if whole string was found */
if (f >= end) {
start = f;
goto done;
};
/* set new offset and shift start string */
offs += cinf - cin;
s = f;
/* if match item, go deeper as long as possible */
if (offs >= item->length && item->childTree.firstPtr) {
/* save previuosly found item (if not ambigous) for
* possible fallback (few greedy match) */
if (item->value != NULL) {
prevf = f;
prevItem = item;
prevParent = parent;
}
parent = &item->childTree;
item = item->childTree.firstPtr;
continue;
}
/* no children - return this item and current chars found */
start = f;
goto done;
}
item = item->nextPtr;
} while (item != NULL);
/* fallback (few greedy match) not ambigous (has a value) */
if (prevItem != NULL) {
item = prevItem;
parent = prevParent;
start = prevf;
}
done:
if (foundParent)
*foundParent = parent;
if (foundItem)
*foundItem = item;
return start;
}
MODULE_SCOPE void
TclStrIdxTreeFree(
TclStrIdx *tree)
{
while (tree != NULL) {
TclStrIdx *t;
Tcl_DecrRefCount(tree->key);
if (tree->childTree.firstPtr != NULL) {
TclStrIdxTreeFree(tree->childTree.firstPtr);
}
t = tree, tree = tree->nextPtr;
ckfree(t);
}
}
/*
* Several bidirectional list primitives
*/
inline void
TclStrIdxTreeInsertBranch(
TclStrIdxTree *parent,
register TclStrIdx *item,
register TclStrIdx *child)
{
if (parent->firstPtr == child)
parent->firstPtr = item;
if (parent->lastPtr == child)
parent->lastPtr = item;
if ( (item->nextPtr = child->nextPtr) ) {
item->nextPtr->prevPtr = item;
child->nextPtr = NULL;
}
if ( (item->prevPtr = child->prevPtr) ) {
item->prevPtr->nextPtr = item;
child->prevPtr = NULL;
}
item->childTree.firstPtr = child;
item->childTree.lastPtr = child;
}
inline void
TclStrIdxTreeAppend(
register TclStrIdxTree *parent,
register TclStrIdx *item)
{
if (parent->lastPtr != NULL) {
parent->lastPtr->nextPtr = item;
}
item->prevPtr = parent->lastPtr;
item->nextPtr = NULL;
parent->lastPtr = item;
if (parent->firstPtr == NULL) {
parent->firstPtr = item;
}
}
/*
*----------------------------------------------------------------------
*
* TclStrIdxTreeBuildFromList --
*
* Build or extend string indexed tree from tcl list.
* If the values not given the values of built list are indices starts with 1.
* Value of 0 is thereby reserved to the ambigous values.
*
* Important: by multiple lists, optimal tree can be created only if list with
* larger strings used firstly.
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE int
TclStrIdxTreeBuildFromList(
TclStrIdxTree *idxTree,
int lstc,
Tcl_Obj **lstv,
ClientData *values)
{
Tcl_Obj **lwrv;
int i, ret = TCL_ERROR;
ClientData val;
const char *s, *e, *f;
TclStrIdx *item;
/* create lowercase reflection of the list keys */
lwrv = ckalloc(sizeof(Tcl_Obj*) * lstc);
if (lwrv == NULL) {
return TCL_ERROR;
}
for (i = 0; i < lstc; i++) {
lwrv[i] = Tcl_DuplicateObj(lstv[i]);
if (lwrv[i] == NULL) {
return TCL_ERROR;
}
Tcl_IncrRefCount(lwrv[i]);
lwrv[i]->length = Tcl_UtfToLower(TclGetString(lwrv[i]));
}
/* build index tree of the list keys */
for (i = 0; i < lstc; i++) {
TclStrIdxTree *foundParent = idxTree;
e = s = TclGetString(lwrv[i]);
e += lwrv[i]->length;
val = values ? values[i] : INT2PTR(i+1);
/* ignore empty keys (impossible to index it) */
if (lwrv[i]->length == 0) continue;
item = NULL;
if (idxTree->firstPtr != NULL) {
TclStrIdx *foundItem;
f = TclStrIdxTreeSearch(&foundParent, &foundItem,
idxTree, s, e);
/* if common prefix was found */
if (f > s) {
/* ignore element if fulfilled or ambigous */
if (f == e) {
continue;
}
/* if shortest key was found with the same value,
* just replace its current key with longest key */
if ( foundItem->value == val
&& foundItem->length < lwrv[i]->length
&& foundItem->childTree.firstPtr == NULL
) {
Tcl_SetObjRef(foundItem->key, lwrv[i]);
foundItem->length = lwrv[i]->length;
continue;
}
/* split tree (e. g. j->(jan,jun) + jul == j->(jan,ju->(jun,jul)) )
* but don't split by fulfilled child of found item ( ii->iii->iiii ) */
if (foundItem->length != (f - s)) {
/* first split found item (insert one between parent and found + new one) */
item = ckalloc(sizeof(*item));
if (item == NULL) {
goto done;
}
Tcl_InitObjRef(item->key, foundItem->key);
item->length = f - s;
/* set value or mark as ambigous if not the same value of both */
item->value = (foundItem->value == val) ? val : NULL;
/* insert group item between foundParent and foundItem */
TclStrIdxTreeInsertBranch(foundParent, item, foundItem);
foundParent = &item->childTree;
} else {
/* the new item should be added as child of found item */
foundParent = &foundItem->childTree;
}
}
}
/* append item at end of found parent */
item = ckalloc(sizeof(*item));
if (item == NULL) {
goto done;
}
item->childTree.lastPtr = item->childTree.firstPtr = NULL;
Tcl_InitObjRef(item->key, lwrv[i]);
item->length = lwrv[i]->length;
item->value = val;
TclStrIdxTreeAppend(foundParent, item);
};
ret = TCL_OK;
done:
if (lwrv != NULL) {
for (i = 0; i < lstc; i++) {
Tcl_DecrRefCount(lwrv[i]);
}
ckfree(lwrv);
}
if (ret != TCL_OK) {
if (idxTree->firstPtr != NULL) {
TclStrIdxTreeFree(idxTree->firstPtr);
}
}
return ret;
}
static void
StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void
StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr);
static void
StrIdxTreeObj_UpdateStringProc(Tcl_Obj *objPtr);
Tcl_ObjType StrIdxTreeObjType = {
"str-idx-tree", /* name */
StrIdxTreeObj_FreeIntRepProc, /* freeIntRepProc */
StrIdxTreeObj_DupIntRepProc, /* dupIntRepProc */
StrIdxTreeObj_UpdateStringProc, /* updateStringProc */
NULL /* setFromAnyProc */
};
MODULE_SCOPE Tcl_Obj*
TclStrIdxTreeNewObj()
{
Tcl_Obj *objPtr = Tcl_NewObj();
objPtr->internalRep.twoPtrValue.ptr1 = NULL;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &StrIdxTreeObjType;
/* return tree root in internal representation */
return objPtr;
}
static void
StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
{
/* follow links (smart pointers) */
if ( srcPtr->internalRep.twoPtrValue.ptr1 != NULL
&& srcPtr->internalRep.twoPtrValue.ptr2 == NULL
) {
srcPtr = (Tcl_Obj*)srcPtr->internalRep.twoPtrValue.ptr1;
}
/* create smart pointer to it (ptr1 != NULL, ptr2 = NULL) */
Tcl_InitObjRef(*((Tcl_Obj **)©Ptr->internalRep.twoPtrValue.ptr1),
srcPtr);
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
copyPtr->typePtr = &StrIdxTreeObjType;
}
static void
StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr)
{
/* follow links (smart pointers) */
if ( objPtr->internalRep.twoPtrValue.ptr1 != NULL
&& objPtr->internalRep.twoPtrValue.ptr2 == NULL
) {
/* is a link */
Tcl_UnsetObjRef(*((Tcl_Obj **)&objPtr->internalRep.twoPtrValue.ptr1));
} else {
/* is a tree */
TclStrIdxTree *tree = (TclStrIdxTree*)&objPtr->internalRep.twoPtrValue.ptr1;
if (tree->firstPtr != NULL) {
TclStrIdxTreeFree(tree->firstPtr);
}
objPtr->internalRep.twoPtrValue.ptr1 = NULL;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
}
objPtr->typePtr = NULL;
};
static void
StrIdxTreeObj_UpdateStringProc(Tcl_Obj *objPtr)
{
/* currently only dummy empty string possible */
objPtr->length = 0;
objPtr->bytes = &tclEmptyString;
};
MODULE_SCOPE TclStrIdxTree *
TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr) {
/* follow links (smart pointers) */
if (objPtr->typePtr != &StrIdxTreeObjType) {
return NULL;
}
if ( objPtr->internalRep.twoPtrValue.ptr1 != NULL
&& objPtr->internalRep.twoPtrValue.ptr2 == NULL
) {
objPtr = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr1;
}
/* return tree root in internal representation */
return (TclStrIdxTree*)&objPtr->internalRep.twoPtrValue.ptr1;
}
/*
* Several debug primitives
*/
#if 0
/* currently unused, debug resp. test purposes only */
void
TclStrIdxTreePrint(
Tcl_Interp *interp,
TclStrIdx *tree,
int offs)
{
Tcl_Obj *obj[2];
const char *s;
Tcl_InitObjRef(obj[0], Tcl_NewStringObj("::puts", -1));
while (tree != NULL) {
s = TclGetString(tree->key) + offs;
Tcl_InitObjRef(obj[1], Tcl_ObjPrintf("%*s%.*s\t:%d",
offs, "", tree->length - offs, s, tree->value));
Tcl_PutsObjCmd(NULL, interp, 2, obj);
Tcl_UnsetObjRef(obj[1]);
if (tree->childTree.firstPtr != NULL) {
TclStrIdxTreePrint(interp, tree->childTree.firstPtr, tree->length);
}
tree = tree->nextPtr;
}
Tcl_UnsetObjRef(obj[0]);
}
MODULE_SCOPE int
TclStrIdxTreeTestObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[])
{
const char *cs, *cin, *ret;
static const char *const options[] = {
"index", "puts-index", "findequal",
NULL
};
enum optionInd {
O_INDEX, O_PUTS_INDEX, O_FINDEQUAL
};
int optionIndex;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], options,
"option", 0, &optionIndex) != TCL_OK) {
Tcl_SetErrorCode(interp, "CLOCK", "badOption",
Tcl_GetString(objv[1]), NULL);
return TCL_ERROR;
}
switch (optionIndex) {
case O_FINDEQUAL:
if (objc < 4) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
cs = TclGetString(objv[2]);
cin = TclGetString(objv[3]);
ret = TclUtfFindEqual(
cs, cs + objv[1]->length, cin, cin + objv[2]->length);
Tcl_SetObjResult(interp, Tcl_NewIntObj(ret - cs));
break;
case O_INDEX:
case O_PUTS_INDEX:
if (1) {
Tcl_Obj **lstv;
int i, lstc;
TclStrIdxTree idxTree = {NULL, NULL};
i = 1;
while (++i < objc) {
if (TclListObjGetElements(interp, objv[i],
&lstc, &lstv) != TCL_OK) {
return TCL_ERROR;
};
TclStrIdxTreeBuildFromList(&idxTree, lstc, lstv, NULL);
}
if (optionIndex == O_PUTS_INDEX) {
TclStrIdxTreePrint(interp, idxTree.firstPtr, 0);
}
TclStrIdxTreeFree(idxTree.firstPtr);
}
break;
}
return TCL_OK;
}
#endif
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Added generic/tclStrIdxTree.h.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 |
/*
* tclStrIdxTree.h --
*
* Declarations of string index tries and other primitives currently
* back-ported from tclSE.
*
* Copyright (c) 2016 Serg G. Brester (aka sebres)
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _TCLSTRIDXTREE_H
#define _TCLSTRIDXTREE_H
/*
* Main structures declarations of index tree and entry
*/
typedef struct TclStrIdxTree {
struct TclStrIdx *firstPtr;
struct TclStrIdx *lastPtr;
} TclStrIdxTree;
typedef struct TclStrIdx {
struct TclStrIdxTree childTree;
struct TclStrIdx *nextPtr;
struct TclStrIdx *prevPtr;
Tcl_Obj *key;
int length;
ClientData value;
} TclStrIdx;
/*
*----------------------------------------------------------------------
*
* TclUtfFindEqual, TclUtfFindEqualNC --
*
* Find largest part of string cs in string cin (case sensitive and not).
*
* Results:
* Return position of UTF character in cs after last equal character.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static inline const char *
TclUtfFindEqual(
register const char *cs, /* UTF string to find in cin. */
register const char *cse, /* End of cs */
register const char *cin, /* UTF string will be browsed. */
register const char *cine) /* End of cin */
{
register const char *ret = cs;
Tcl_UniChar ch1, ch2;
do {
cs += TclUtfToUniChar(cs, &ch1);
cin += TclUtfToUniChar(cin, &ch2);
if (ch1 != ch2) break;
} while ((ret = cs) < cse && cin < cine);
return ret;
}
static inline const char *
TclUtfFindEqualNC(
register const char *cs, /* UTF string to find in cin. */
register const char *cse, /* End of cs */
register const char *cin, /* UTF string will be browsed. */
register const char *cine, /* End of cin */
const char **cinfnd) /* Return position in cin */
{
register const char *ret = cs;
Tcl_UniChar ch1, ch2;
do {
cs += TclUtfToUniChar(cs, &ch1);
cin += TclUtfToUniChar(cin, &ch2);
if (ch1 != ch2) {
ch1 = Tcl_UniCharToLower(ch1);
ch2 = Tcl_UniCharToLower(ch2);
if (ch1 != ch2) break;
}
*cinfnd = cin;
} while ((ret = cs) < cse && cin < cine);
return ret;
}
static inline const char *
TclUtfFindEqualNCInLwr(
register const char *cs, /* UTF string (in anycase) to find in cin. */
register const char *cse, /* End of cs */
register const char *cin, /* UTF string (in lowercase) will be browsed. */
register const char *cine, /* End of cin */
const char **cinfnd) /* Return position in cin */
{
register const char *ret = cs;
Tcl_UniChar ch1, ch2;
do {
cs += TclUtfToUniChar(cs, &ch1);
cin += TclUtfToUniChar(cin, &ch2);
if (ch1 != ch2) {
ch1 = Tcl_UniCharToLower(ch1);
if (ch1 != ch2) break;
}
*cinfnd = cin;
} while ((ret = cs) < cse && cin < cine);
return ret;
}
static inline const char *
TclUtfNext(
register const char *src) /* The current location in the string. */
{
if (((unsigned char) *(src)) < 0xC0) {
return ++src;
} else {
Tcl_UniChar ch;
return src + TclUtfToUniChar(src, &ch);
}
}
/*
* Primitives to safe set, reset and free references.
*/
#define Tcl_UnsetObjRef(obj) \
if (obj != NULL) { Tcl_DecrRefCount(obj); obj = NULL; }
#define Tcl_InitObjRef(obj, val) \
obj = val; if (obj) { Tcl_IncrRefCount(obj); }
#define Tcl_SetObjRef(obj, val) \
if (1) { \
Tcl_Obj *nval = val; \
if (obj != nval) { \
Tcl_Obj *prev = obj; \
Tcl_InitObjRef(obj, nval); \
if (prev != NULL) { Tcl_DecrRefCount(prev); }; \
} \
}
/*
* Prototypes of module functions.
*/
MODULE_SCOPE const char*
TclStrIdxTreeSearch(TclStrIdxTree **foundParent,
TclStrIdx **foundItem, TclStrIdxTree *tree,
const char *start, const char *end);
MODULE_SCOPE int TclStrIdxTreeBuildFromList(TclStrIdxTree *idxTree,
int lstc, Tcl_Obj **lstv, ClientData *values);
MODULE_SCOPE Tcl_Obj*
TclStrIdxTreeNewObj();
MODULE_SCOPE TclStrIdxTree*
TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr);
#if 1
MODULE_SCOPE int TclStrIdxTreeTestObjCmd(ClientData, Tcl_Interp *,
int, Tcl_Obj *const objv[]);
#endif
#endif /* _TCLSTRIDXTREE_H */
|
Changes to generic/tclStringObj.c.
| ︙ | ︙ | |||
2728 2729 2730 2731 2732 2733 2734 |
* Produce pure bytearray when possible.
* Error on overflow.
*/
if (!binary) {
if (objPtr->typePtr == &tclStringType) {
String *stringPtr = GET_STRING(objPtr);
| | | 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 |
* Produce pure bytearray when possible.
* Error on overflow.
*/
if (!binary) {
if (objPtr->typePtr == &tclStringType) {
String *stringPtr = GET_STRING(objPtr);
if (stringPtr->flags & TCL_HAS_UNICODE) {
unichar = 1;
}
}
}
if (binary) {
/* Result will be pure byte array. Pre-size it */
|
| ︙ | ︙ |
Changes to generic/tclUtf.c.
| ︙ | ︙ | |||
298 299 300 301 302 303 304 |
} else if (byte < 0xE0) {
if ((src[1] & 0xC0) == 0x80) {
/*
* Two-byte-character lead-byte followed by a trail-byte.
*/
*chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (src[1] & 0x3F));
| | | | 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 |
} else if (byte < 0xE0) {
if ((src[1] & 0xC0) == 0x80) {
/*
* Two-byte-character lead-byte followed by a trail-byte.
*/
*chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (src[1] & 0x3F));
if ((*chPtr == 0) || (*chPtr > 0x7f)) {
return 2;
}
}
/*
* A two-byte-character lead-byte not followed by trail-byte
* represents itself.
*/
} else if (byte < 0xF0) {
if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) {
/*
* Three-byte-character lead byte followed by two trail bytes.
*/
*chPtr = (Tcl_UniChar) (((byte & 0x0F) << 12)
| ((src[1] & 0x3F) << 6) | (src[2] & 0x3F));
if (*chPtr > 0x7ff) {
return 3;
}
}
/*
* A three-byte-character lead-byte not followed by two trail-bytes
* represents itself.
|
| ︙ | ︙ | |||
349 350 351 352 353 354 355 |
return 0;
} else {
/* produce low surrogate, and advance source pointer */
*chPtr = (Tcl_UniChar) (0xDC00 | (byte & 0x3FF));
return 4;
}
#else
| | | 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 |
return 0;
} else {
/* produce low surrogate, and advance source pointer */
*chPtr = (Tcl_UniChar) (0xDC00 | (byte & 0x3FF));
return 4;
}
#else
*chPtr = (Tcl_UniChar) (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
| ((src[2] & 0x3F) << 6) | (src[3] & 0x3F));
if ((*chPtr <= 0x10ffff) && (*chPtr > 0xffff)) {
return 4;
}
#endif
}
|
| ︙ | ︙ |
Changes to library/clock.tcl.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | #---------------------------------------------------------------------- # # clock.tcl -- # # This file implements the portions of the [clock] ensemble that are # coded in Tcl. Refer to the users' manual to see the description of # the [clock] command and its subcommands. # # #---------------------------------------------------------------------- # # Copyright (c) 2004,2005,2006,2007 by Kevin B. Kenny # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # #---------------------------------------------------------------------- # We must have message catalogs that support the root locale, and we need # access to the Registry on Windows systems. | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | #---------------------------------------------------------------------- # # clock.tcl -- # # This file implements the portions of the [clock] ensemble that are # coded in Tcl. Refer to the users' manual to see the description of # the [clock] command and its subcommands. # # #---------------------------------------------------------------------- # # Copyright (c) 2004,2005,2006,2007 by Kevin B. Kenny # Copyright (c) 2015 by Sergey G. Brester aka sebres. # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # #---------------------------------------------------------------------- # We must have message catalogs that support the root locale, and we need # access to the Registry on Windows systems. |
| ︙ | ︙ | |||
283 284 285 286 287 288 289 290 291 292 293 294 295 296 |
variable MINWIDE -9223372036854775808
variable MAXWIDE 9223372036854775807
# Day before Leap Day
variable FEB_28 58
# Translation table to map Windows TZI onto cities, so that the Olson
# rules can apply. In some cases the mapping is ambiguous, so it's wise
# to specify $::env(TCL_TZ) rather than simply depending on the system
# time zone.
# The keys are long lists of values obtained from the time zone
# information in the Registry. In order, the list elements are:
| > > > > > > | 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 |
variable MINWIDE -9223372036854775808
variable MAXWIDE 9223372036854775807
# Day before Leap Day
variable FEB_28 58
# Default configuration
configure -default-locale [mclocale]
#configure -year-century 2000 \
# -century-switch 38
# Translation table to map Windows TZI onto cities, so that the Olson
# rules can apply. In some cases the mapping is ambiguous, so it's wise
# to specify $::env(TCL_TZ) rather than simply depending on the system
# time zone.
# The keys are long lists of values obtained from the time zone
# information in the Registry. In order, the list elements are:
|
| ︙ | ︙ | |||
379 380 381 382 383 384 385 |
{36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Sydney
{39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Noumea
{43200 0 3600 0 3 0 3 3 0 0 0 0 10 0 1 2 0 0 0} :Pacific/Auckland
{43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Fiji
{46800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Tongatapu
}]
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 386 387 388 389 390 391 392 393 394 395 396 397 398 399 |
{36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Sydney
{39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Noumea
{43200 0 3600 0 3 0 3 3 0 0 0 0 10 0 1 2 0 0 0} :Pacific/Auckland
{43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Fiji
{46800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Tongatapu
}]
# Legacy time zones, used primarily for parsing RFC822 dates.
variable LegacyTimeZone [dict create \
gmt +0000 \
ut +0000 \
utc +0000 \
bst +0100 \
|
| ︙ | ︙ | |||
619 620 621 622 623 624 625 |
x -1100 \
y -1200 \
z +0000 \
]
# Caches
| > > > | > < < < < | > > > | < < < < < < < < | < | < < | < < < | < | < < < < < < < < < | < < < | < < < < < < < < < < < < < < < < < | < < | < < < | < | < < < | < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < | < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < | < < < < < < < < < < < < < < < < < < < < < < < < | | < | < | < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < < < < < < | < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < | < < | < < < < < < < < < < | < | < < < < < < < < < < < < < < < < < < < < < | < | < | < < < < | < < < < < < < < | < < | < < | < < < < < < | < | < < < < | < < < < < < < | < < < < < < < | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < | < | < < < < < < < < < < | < < < < < < < < | < | < < < < < < | < | < < < < < < < < < < < < < < < < < < < < < < < | < | < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < | < | < | < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < > | | < < < < < < | < | < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < | < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < | < < < | < < | < < < < < | | | < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < > > | < < < < < < < < > | < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < | < > > | < | < | < < < < < < < < < < < < < < < < | < < | < < < < < < < < < < < | < | < | < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < | < < < < < < < < < < < < < < < < | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < | < < < < < < < < < < < < < < < < < < < < < < < < | < < < | < | < < < < | < < < < < < < < < < | < < < < < < < < < < < < < < | < < < < < | < | | < < < < < < < < < < < < < < < < < < < < < < < | < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < < < | < < < < < < < < < < < < < < < < < | | > | 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 |
x -1100 \
y -1200 \
z +0000 \
]
# Caches
variable LocaleFormats \
[dict create]; # Dictionary with localized formats
variable LocaleNumeralCache \
[dict create]; # Dictionary whose keys are locale
# names and whose values are pairs
# comprising regexes matching numerals
# in the given locales and dictionaries
# mapping the numerals to their numeric
# values.
variable TimeZoneBad [dict create]; # Dictionary whose keys are time zone
# names and whose values are 1 if
# the time zone is unknown and 0
# if it is known.
variable TZData; # Array whose keys are time zone names
# and whose values are lists of quads
# comprising start time, UTC offset,
# Daylight Saving Time indicator, and
# time zone abbreviation.
variable FormatProc; # Array mapping format group
# and locale to the name of a procedure
# that renders the given format
variable mcLocales [dict create]; # Dictionary with loaded locales
variable mcMergedCat [dict create]; # Dictionary with merged locale catalogs
}
::tcl::clock::Initialize
#----------------------------------------------------------------------
# mcget --
#
# Return the merged translation catalog for the ::tcl::clock namespace
# Searching of catalog is similar to "msgcat::mc".
#
# Contrary to "msgcat::mc" may additionally load a package catalog
# on demand.
#
# Arguments:
# loc The locale used for translation.
#
# Results:
# Returns the dictionary object as whole catalog of the package/locale.
#
proc mcget {loc} {
variable mcMergedCat
switch -- $loc system {
set loc [GetSystemLocale]
} current {
set loc [mclocale]
}
if {$loc eq {C}} {
set loclist [msgcat::PackagePreferences ::tcl::clock]
set loc [lindex $loclist 0]
} else {
set loc [string tolower $loc]
}
# try to retrieve now if already available:
if {[dict exists $mcMergedCat $loc]} {
set mrgcat [dict get $mcMergedCat $loc]
return [dict smartref $mrgcat]
}
# get locales list for given locale (de_de -> {de_de de {}})
variable mcLocales
if {[dict exists $mcLocales $loc]} {
set loclist [dict get $mcLocales $loc]
} else {
# save current locale:
set prevloc [mclocale]
# lazy load catalog on demand (set it will load the catalog)
mcpackagelocale set $loc
set loclist [msgcat::GetPreferences $loc]
dict set $mcLocales $loc $loclist
# restore:
if {$prevloc ne $loc} {
mcpackagelocale set $prevloc
}
}
# get whole catalog:
mcMerge $loclist
}
# mcMerge --
#
# Merge message catalog dictionaries to one dictionary.
#
# Arguments:
# locales List of locales to merge.
#
# Results:
# Returns the (weak pointer) to merged dictionary of message catalog.
#
proc mcMerge {locales} {
variable mcMergedCat
if {[dict exists $mcMergedCat [set loc [lindex $locales 0]]]} {
set mrgcat [dict get $mcMergedCat $loc]
return [dict smartref $mrgcat]
}
# package msgcat currently does not provide possibility to get whole catalog:
upvar ::msgcat::Msgs Msgs
set ns ::tcl::clock
# Merge sequential locales (in reverse order, e. g. {} -> en -> en_en):
if {[llength $locales] > 1} {
set mrgcat [mcMerge [lrange $locales 1 end]]
if {[dict exists $Msgs $ns $loc]} {
set mrgcat [dict merge $mrgcat [dict get $Msgs $ns $loc]]
}
} else {
if {[dict exists $Msgs $ns $loc]} {
set mrgcat [dict get $Msgs $ns $loc]
} else {
set mrgcat [dict create]
}
}
dict set mcMergedCat $loc $mrgcat
# return smart reference (shared dict as object with exact one ref-counter)
return [dict smartref $mrgcat]
}
#----------------------------------------------------------------------
#
# GetSystemLocale --
#
# Determines the system locale, which corresponds to "system"
# keyword for locale parameter of 'clock' command.
#
# Parameters:
# None.
#
# Results:
# Returns the system locale.
#
# Side effects:
# None
#
#----------------------------------------------------------------------
proc ::tcl::clock::GetSystemLocale {} {
if { $::tcl_platform(platform) ne {windows} } {
# On a non-windows platform, the 'system' locale is the same as
# the 'current' locale
return [mclocale]
}
# On a windows platform, the 'system' locale is adapted from the
# 'current' locale by applying the date and time formats from the
# Control Panel. First, load the 'current' locale if it's not yet
# loaded
mcpackagelocale set [mclocale]
# Make a new locale string for the system locale, and get the
# Control Panel information
set locale [mclocale]_windows
if { ! [mcpackagelocale present $locale] } {
LoadWindowsDateTimeFormats $locale
}
return $locale
}
#----------------------------------------------------------------------
#
# EnterLocale --
#
# Switch [mclocale] to a given locale if necessary
#
# Parameters:
# locale -- Desired locale
#
# Results:
# Returns the locale that was previously current.
#
# Side effects:
# Does [mclocale]. If necessary, loades the designated locale's files.
#
#----------------------------------------------------------------------
proc ::tcl::clock::EnterLocale { locale } {
switch -- $locale system {
set locale [GetSystemLocale]
} current {
set locale [mclocale]
}
# Select the locale, eventually load it
mcpackagelocale set $locale
return $locale
}
#----------------------------------------------------------------------
#
# LoadWindowsDateTimeFormats --
#
# Load the date/time formats from the Control Panel in Windows and
|
| ︙ | ︙ | |||
2476 2477 2478 2479 2480 2481 2482 | # substituted out. # # Side effects: # None. # #---------------------------------------------------------------------- | | > < | > > > > | > > | > > | | | | | | | | | | < < < < < < < < < < < | < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < | < | < | < | < | < | < < < < < | < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < | < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < | < < | < < | < < | < < | < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < | < < | < | < | < | < < < < < | < < < < < < < < < < < < < < < < < < < < | < < < < < < < | < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < | | < | | | | > | | | | | | | | | < | > | | < < | | < < < < < < < < < < < < < < < < < < < < | < < < < < < < | | > > > > > > > | 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 |
# substituted out.
#
# Side effects:
# None.
#
#----------------------------------------------------------------------
proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } {
variable LocaleFormats
if { $fmtkey eq {} } { set fmtkey FMT_$format }
if { [catch {
set locfmt [dict get $LocaleFormats $locale $fmtkey]
}] } {
# get map list cached or build it:
if { [catch {
set mlst [dict get $LocaleFormats $locale MLST]
}] } {
# message catalog dictionary:
set mcd [mcget $locale]
# Handle locale-dependent format groups by mapping them out of the format
# string. Note that the order of the [string map] operations is
# significant because later formats can refer to later ones; for example
# %c can refer to %X, which in turn can refer to %T.
set mlst {
%% %%
%D %m/%d/%Y
%+ {%a %b %e %H:%M:%S %Z %Y}
}
lappend mlst %EY [string map $mlst [dict get $mcd LOCALE_YEAR_FORMAT]]
lappend mlst %T [string map $mlst [dict get $mcd TIME_FORMAT_24_SECS]]
lappend mlst %R [string map $mlst [dict get $mcd TIME_FORMAT_24]]
lappend mlst %r [string map $mlst [dict get $mcd TIME_FORMAT_12]]
lappend mlst %X [string map $mlst [dict get $mcd TIME_FORMAT]]
lappend mlst %EX [string map $mlst [dict get $mcd LOCALE_TIME_FORMAT]]
lappend mlst %x [string map $mlst [dict get $mcd DATE_FORMAT]]
lappend mlst %Ex [string map $mlst [dict get $mcd LOCALE_DATE_FORMAT]]
lappend mlst %c [string map $mlst [dict get $mcd DATE_TIME_FORMAT]]
lappend mlst %Ec [string map $mlst [dict get $mcd LOCALE_DATE_TIME_FORMAT]]
dict set LocaleFormats $locale MLST $mlst
}
# translate copy of format (don't use format object here, because otherwise
# it can lose its internal representation (string map - convert to unicode)
set locfmt [string map $mlst [string range " $format" 1 end]]
# cache it:
dict set LocaleFormats $locale $fmtkey $locfmt
}
# Save original format as long as possible, because of internal
# representation (performance).
# Note that in this case such format will be never localized (also
# using another locales). To prevent this return a duplicate (but
# it may be slower).
if {$locfmt eq $format} {
set locfmt $format
}
return $locfmt
}
#----------------------------------------------------------------------
#
# GetSystemTimeZone --
#
# Determines the system time zone, which is the default for the
# 'clock' command if no other zone is supplied.
#
# Parameters:
# None.
#
# Results:
# Returns the system time zone.
#
# Side effects:
# Stores the sustem time zone in engine configuration, since
# determining it may be an expensive process.
#
#----------------------------------------------------------------------
proc ::tcl::clock::GetSystemTimeZone {} {
variable TimeZoneBad
if {[set result [getenv TCL_TZ]] ne {}} {
set timezone $result
} elseif {[set result [getenv TZ]] ne {}} {
set timezone $result
}
if {![info exists timezone]} {
# ask engine for the cached timezone:
set timezone [configure -system-tz]
if { $timezone ne "" } {
return $timezone
}
if { $::tcl_platform(platform) eq {windows} } {
set timezone [GuessWindowsTimeZone]
} elseif { [file exists /etc/localtime]
&& ![catch {ReadZoneinfoFile \
Tcl/Localtime /etc/localtime}] } {
set timezone :Tcl/Localtime
} else {
set timezone :localtime
}
}
if { ![dict exists $TimeZoneBad $timezone] } {
catch {set timezone [SetupTimeZone $timezone]}
}
if { [dict exists $TimeZoneBad $timezone] } {
set timezone :localtime
}
# tell backend - current system timezone:
configure -system-tz $timezone
return $timezone
}
#----------------------------------------------------------------------
#
# SetupTimeZone --
#
# Given the name or specification of a time zone, sets up its in-memory
# data.
#
# Parameters:
# tzname - Name of a time zone
#
# Results:
# Unless the time zone is ':localtime', sets the TZData array to contain
# the lookup table for local<->UTC conversion. Returns an error if the
# time zone cannot be parsed.
#
#----------------------------------------------------------------------
proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } {
variable TZData
if {! [info exists TZData($timezone)] } {
variable TimeZoneBad
if { [dict exists $TimeZoneBad $timezone] } {
return -code error \
-errorcode [list CLOCK badTimeZone $timezone] \
"time zone \"$timezone\" not found"
}
variable MINWIDE
if { $timezone eq {:localtime} } {
# Nothing to do, we'll convert using the localtime function
} elseif {
[regexp {^([-+])(\d\d)(?::?(\d\d)(?::?(\d\d))?)?} $timezone \
-> s hh mm ss]
|
| ︙ | ︙ | |||
3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 |
if {
[catch {
LoadTimeZoneFile [string range $timezone 1 end]
}] && [catch {
LoadZoneinfoFile [string range $timezone 1 end]
}]
} then {
return -code error \
-errorcode [list CLOCK badTimeZone $timezone] \
"time zone \"$timezone\" not found"
}
} elseif { ![catch {ParsePosixTimeZone $timezone} tzfields] } {
# This looks like a POSIX time zone - try to process it
if { [catch {ProcessPosixTimeZone $tzfields} data opts] } {
if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
dict unset opts -errorinfo
}
return -options $opts $data
} else {
set TZData($timezone) $data
}
} else {
# We couldn't parse this as a POSIX time zone. Try again with a
# time zone file - this time without a colon
if { [catch { LoadTimeZoneFile $timezone }]
&& [catch { LoadZoneinfoFile $timezone } - opts] } {
dict unset opts -errorinfo
return -options $opts "time zone $timezone not found"
}
set TZData($timezone) $TZData(:$timezone)
}
}
| > > > > > > > > > > > > > > > > > > | > | 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 |
if {
[catch {
LoadTimeZoneFile [string range $timezone 1 end]
}] && [catch {
LoadZoneinfoFile [string range $timezone 1 end]
}]
} then {
dict set TimeZoneBad $timezone 1
return -code error \
-errorcode [list CLOCK badTimeZone $timezone] \
"time zone \"$timezone\" not found"
}
} elseif { ![catch {ParsePosixTimeZone $timezone} tzfields] } {
# This looks like a POSIX time zone - try to process it
if { [catch {ProcessPosixTimeZone $tzfields} data opts] } {
if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
dict unset opts -errorinfo
}
dict set TimeZoneBad $timezone 1
return -options $opts $data
} else {
set TZData($timezone) $data
}
} else {
variable LegacyTimeZone
# We couldn't parse this as a POSIX time zone. Try again with a
# time zone file - this time without a colon
if { [catch { LoadTimeZoneFile $timezone }]
&& [catch { LoadZoneinfoFile $timezone } - opts] } {
# Check may be a legacy zone:
if { $alias eq {} && ![catch {
set tzname [dict get $LegacyTimeZone [string tolower $timezone]]
}] } {
set tzname [::tcl::clock::SetupTimeZone $tzname $timezone]
set TZData($timezone) $TZData($tzname)
# tell backend - timezone is initialized and return shared timezone object:
return [configure -setup-tz $timezone]
}
dict unset opts -errorinfo
dict set TimeZoneBad $timezone 1
return -options $opts "time zone $timezone not found"
}
set TZData($timezone) $TZData(:$timezone)
}
}
# tell backend - timezone is initialized and return shared timezone object:
configure -setup-tz $timezone
}
#----------------------------------------------------------------------
#
# GuessWindowsTimeZone --
#
# Determines the system time zone on windows.
|
| ︙ | ︙ | |||
3201 3202 3203 3204 3205 3206 3207 |
# Make up a Posix time zone specifier if we can't find one. Check here
# that the tzdata file exists, in case we're running in an environment
# (e.g. starpack) where tzdata is incomplete. (Bug 1237907)
if { [dict exists $WinZoneInfo $data] } {
set tzname [dict get $WinZoneInfo $data]
if { ! [dict exists $TimeZoneBad $tzname] } {
| | | | 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 |
# Make up a Posix time zone specifier if we can't find one. Check here
# that the tzdata file exists, in case we're running in an environment
# (e.g. starpack) where tzdata is incomplete. (Bug 1237907)
if { [dict exists $WinZoneInfo $data] } {
set tzname [dict get $WinZoneInfo $data]
if { ! [dict exists $TimeZoneBad $tzname] } {
catch {set tzname [SetupTimeZone $tzname]}
}
} else {
set tzname {}
}
if { $tzname eq {} || [dict exists $TimeZoneBad $tzname] } {
lassign $data \
bias stdBias dstBias \
stdYear stdMonth stdDayOfWeek stdDayOfMonth \
stdHour stdMinute stdSecond stdMillisec \
dstYear dstMonth dstDayOfWeek dstDayOfMonth \
dstHour dstMinute dstSecond dstMillisec
set stdDelta [expr { $bias + $stdBias }]
|
| ︙ | ︙ | |||
3933 3934 3935 3936 3937 3938 3939 |
}
set tod [expr { ( $h * 60 + $m ) * 60 + $s }]
return [expr { $seconds + $tod }]
}
#----------------------------------------------------------------------
#
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 |
}
set tod [expr { ( $h * 60 + $m ) * 60 + $s }]
return [expr { $seconds + $tod }]
}
#----------------------------------------------------------------------
#
# GetJulianDayFromEraYearDay --
#
# Given a year, month and day on the Gregorian calendar, determines
# the Julian Day Number beginning at noon on that date.
#
# Parameters:
# date -- A dictionary in which the 'era', 'year', and
|
| ︙ | ︙ | |||
4147 4148 4149 4150 4151 4152 4153 |
proc ::tcl::clock::WeekdayOnOrBefore { weekday j } {
set k [expr { ( $weekday + 6 ) % 7 }]
return [expr { $j - ( $j - $k ) % 7 }]
}
#----------------------------------------------------------------------
#
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < > > > < < | 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 |
proc ::tcl::clock::WeekdayOnOrBefore { weekday j } {
set k [expr { ( $weekday + 6 ) % 7 }]
return [expr { $j - ( $j - $k ) % 7 }]
}
#----------------------------------------------------------------------
#
# ChangeCurrentLocale --
#
# The global locale was changed within msgcat.
# Clears the buffered parse functions of the current locale.
#
# Parameters:
# loclist (ignored)
#
# Results:
# None.
#
# Side effects:
# Buffered parse functions are cleared.
#
#----------------------------------------------------------------------
proc ::tcl::clock::ChangeCurrentLocale {args} {
configure -default-locale [lindex $args 0]
variable FormatProc
variable LocaleNumeralCache
foreach p [info procs [namespace current]::scanproc'*'current] {
rename $p {}
}
foreach p [info procs [namespace current]::formatproc'*'current] {
rename $p {}
}
|
| ︙ | ︙ | |||
4576 4577 4578 4579 4580 4581 4582 4583 |
# Side effects:
# Caches are cleared.
#
#----------------------------------------------------------------------
proc ::tcl::clock::ClearCaches {} {
variable FormatProc
variable LocaleNumeralCache
| > | > > > > > > | > < | 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 |
# Side effects:
# Caches are cleared.
#
#----------------------------------------------------------------------
proc ::tcl::clock::ClearCaches {} {
variable FormatProc
variable LocaleFormats
variable LocaleNumeralCache
variable mcMergedCat
variable TimeZoneBad
# tell backend - should invalidate:
configure -clear
# clear msgcat cache:
set mcMergedCat [dict create]
foreach p [info procs [namespace current]::scanproc'*] {
rename $p {}
}
foreach p [info procs [namespace current]::formatproc'*] {
rename $p {}
}
unset -nocomplain FormatProc
set LocaleFormats {}
set LocaleNumeralCache {}
set TimeZoneBad {}
InitTZData
}
|
Changes to library/init.tcl.
| ︙ | ︙ | |||
63 64 65 66 67 68 69 |
if {$Dir ni $::auto_path} {
lappend ::auto_path $Dir
}
}
}
if {![interp issafe]} {
| | | | | | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 |
if {$Dir ni $::auto_path} {
lappend ::auto_path $Dir
}
}
}
if {![interp issafe]} {
variable Path [encoding dirs]
set Dir [file join $::tcl_library encoding]
if {$Dir ni $Path} {
lappend Path $Dir
encoding dirs $Path
}
}
# TIP #255 min and max functions
namespace eval mathfunc {
proc min {args} {
if {![llength $args]} {
return -code error \
|
| ︙ | ︙ | |||
154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 |
# Setup the unknown package handler
if {[interp issafe]} {
package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
} else {
# Set up search for Tcl Modules (TIP #189).
# and setup platform specific unknown package handlers
if {$tcl_platform(os) eq "Darwin"
&& $tcl_platform(platform) eq "unix"} {
package unknown {::tcl::tm::UnknownHandler \
{::tcl::MacOSXPkgUnknown ::tclPkgUnknown}}
} else {
package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
}
# Set up the 'clock' ensemble
| > > > > > > > > > > > < | < < | | | < < < | > > > | > | | > > | < | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 |
# Setup the unknown package handler
if {[interp issafe]} {
package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
} else {
# Default known auto_index (avoid loading auto index implicit after interp create):
array set ::auto_index {
::tcl::tm::UnknownHandler {source [info library]/tm.tcl}
::tclPkgUnknown {source [info library]/package.tcl}
::history {source [info library]/history.tcl}
}
# The newest possibility to load whole namespace:
array set ::auto_index_ns {}
# Set up search for Tcl Modules (TIP #189).
# and setup platform specific unknown package handlers
if {$tcl_platform(os) eq "Darwin"
&& $tcl_platform(platform) eq "unix"} {
package unknown {::tcl::tm::UnknownHandler \
{::tcl::MacOSXPkgUnknown ::tclPkgUnknown}}
} else {
package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
}
# Set up the 'clock' ensemble
proc clock args {
set cmdmap [dict create]
foreach cmd {add clicks format microseconds milliseconds scan seconds configure} {
dict set cmdmap $cmd ::tcl::clock::$cmd
}
namespace inscope ::tcl::clock [list namespace ensemble create -command \
[uplevel 1 [list ::namespace origin [::lindex [info level 0] 0]]] \
-map $cmdmap -compile 1]
uplevel 1 [info level 0]
}
# Auto-loading stubs for 'clock.tcl'
set ::auto_index_ns(::tcl::clock) {::namespace inscope ::tcl::clock {
::source -encoding utf-8 [::file join [info library] clock.tcl]
}}
}
# Conditionalize for presence of exec.
if {[namespace which -command exec] eq ""} {
# Some machines do not have exec. Also, on all
|
| ︙ | ︙ | |||
409 410 411 412 413 414 415 |
# Arguments:
# cmd - Name of the command to find and load.
# namespace (optional) The namespace where the command is being used - must be
# a canonical namespace as returned [namespace current]
# for instance. If not given, namespace current is used.
proc auto_load {cmd {namespace {}}} {
| | > | > > | > | < > > | < | | < < < < | | > > | > > > > > > > > > > > | 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 |
# Arguments:
# cmd - Name of the command to find and load.
# namespace (optional) The namespace where the command is being used - must be
# a canonical namespace as returned [namespace current]
# for instance. If not given, namespace current is used.
proc auto_load {cmd {namespace {}}} {
global auto_index auto_index_ns auto_path
# qualify names:
if {$namespace eq ""} {
set namespace [uplevel 1 [list ::namespace current]]
}
set nameList [auto_qualify $cmd $namespace]
# workaround non canonical auto_index entries that might be around
# from older auto_mkindex versions
if {$cmd ni $nameList} {lappend nameList $cmd}
# try to load (and create sub-cmd handler "_sub_load_cmd" for further usage):
foreach name $nameList [set _sub_load_cmd {
# via auto_index:
if {[info exists auto_index($name)]} {
namespace inscope :: $auto_index($name)
# There's a couple of ways to look for a command of a given
# name. One is to use
# info commands $name
# Unfortunately, if the name has glob-magic chars in it like *
# or [], it may not match. For our purposes here, a better
# route is to use
# namespace which -command $name
if {[namespace which -command $name] ne ""} {
return 1
}
}
# via auto_index_ns - resolver for the whole namespace loaders
if {[set ns [::namespace qualifiers $name]] ni {"" "::"} &&
[info exists auto_index_ns($ns)]
} {
# remove handler before loading (prevents several self-recursion cases):
set ldr $auto_index_ns($ns); unset auto_index_ns($ns)
namespace inscope :: $ldr
# if got it:
if {[namespace which -command $name] ne ""} {
return 1
}
}
}]
# load auto_index if possible:
if {![info exists auto_path]} {
return 0
}
if {![auto_load_index]} {
return 0
}
# try again (something new could be loaded):
foreach name $nameList $_sub_load_cmd
return 0
}
# ::tcl::Pkg::source --
# This procedure provides an alternative "source" command, which doesn't
# register the file for the "package files" command. Safe interpreters
# don't have to do anything special.
|
| ︙ | ︙ | |||
610 611 612 613 614 615 616 |
set ns [uplevel 1 [list ::namespace current]]
set patternList [auto_qualify $pattern $ns]
auto_load_index
foreach pattern $patternList {
| | | | | | | 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 |
set ns [uplevel 1 [list ::namespace current]]
set patternList [auto_qualify $pattern $ns]
auto_load_index
foreach pattern $patternList {
foreach name [array names auto_index $pattern] {
if {([namespace which -command $name] eq "")
&& ([namespace qualifiers $pattern] eq [namespace qualifiers $name])} {
namespace inscope :: $auto_index($name)
}
}
}
}
# auto_execok --
#
# Returns string that indicates name of program to execute if
# name corresponds to a shell builtin or an executable in the
|
| ︙ | ︙ |
Added tests-perf/clock.perf.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 |
#!/usr/bin/tclsh
# ------------------------------------------------------------------------
#
# test-performance.tcl --
#
# This file provides common performance tests for comparison of tcl-speed
# degradation by switching between branches.
# (currently for clock ensemble only)
#
# ------------------------------------------------------------------------
#
# Copyright (c) 2014 Serg G. Brester (aka sebres)
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#
## set testing defaults:
set ::env(TCL_TZ) :CET
# warm-up interpeter compiler env, clock platform-related features,
# calibrate timerate measurement functionality:
puts -nonewline "Calibration ... "; flush stdout
puts "done: [lrange \
[timerate -calibrate {}] \
0 1]"
## warm-up test-related features (load clock.tcl, system zones, locales, etc.):
clock scan "" -gmt 1
clock scan ""
clock scan "" -timezone :CET
clock scan "" -format "" -locale en
clock scan "" -format "" -locale de
## ------------------------------------------
proc {**STOP**} {args} {
return -code error -level 4 "**STOP** in [info level [expr {[info level]-2}]] [join $args { }]"
}
proc _test_get_commands {lst} {
regsub -all {(?:^|\n)[ \t]*(\#[^\n]*|\msetup\M[^\n]*|\mcleanup\M[^\n]*)(?=\n\s*(?:[\{\#]|setup|cleanup))} $lst "\n{\\1}"
}
proc _test_out_total {} {
upvar _ _
set tcnt [llength $_(itm)]
if {!$tcnt} {
puts ""
return
}
set mintm 0x7fffffff
set maxtm 0
set nett 0
set wtm 0
set wcnt 0
set i 0
foreach tm $_(itm) {
if {[llength $tm] > 6} {
set nett [expr {$nett + [lindex $tm 6]}]
}
set wtm [expr {$wtm + [lindex $tm 0]}]
set wcnt [expr {$wcnt + [lindex $tm 2]}]
set tm [lindex $tm 0]
if {$tm > $maxtm} {set maxtm $tm; set maxi $i}
if {$tm < $mintm} {set mintm $tm; set mini $i}
incr i
}
puts [string repeat ** 40]
set s [format "%d cases in %.2f sec." $tcnt [expr {$tcnt * $_(reptime) / 1000.0}]]
if {$nett > 0} {
append s [format " (%.2f nett-sec.)" [expr {$nett / 1000.0}]]
}
puts "Total $s:"
lset _(m) 0 [format %.6f $wtm]
lset _(m) 2 $wcnt
lset _(m) 4 [format %.3f [expr {$wcnt / (($nett ? $nett : ($tcnt * $_(reptime))) / 1000.0)}]]
if {[llength $_(m)] > 6} {
lset _(m) 6 [format %.3f $nett]
}
puts $_(m)
puts "Average:"
lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / $tcnt}]]
lset _(m) 2 [expr {[lindex $_(m) 2] / $tcnt}]
if {[llength $_(m)] > 6} {
lset _(m) 6 [format %.3f [expr {[lindex $_(m) 6] / $tcnt}]]
lset _(m) 4 [format %.0f [expr {[lindex $_(m) 2] / [lindex $_(m) 6] * 1000}]]
}
puts $_(m)
puts "Min:"
puts [lindex $_(itm) $mini]
puts "Max:"
puts [lindex $_(itm) $maxi]
puts [string repeat ** 40]
puts ""
}
proc _test_run {reptime lst {outcmd {puts $_(r)}}} {
upvar _ _
array set _ [list itm {} reptime $reptime]
foreach _(c) [_test_get_commands $lst] {
puts "% [regsub -all {\n[ \t]*} $_(c) {; }]"
if {[regexp {^\s*\#} $_(c)]} continue
if {[regexp {^\s*(?:setup|cleanup)\s+} $_(c)]} {
puts [if 1 [lindex $_(c) 1]]
continue
}
set _(r) [if 1 $_(c)]
if {$outcmd ne {}} $outcmd
puts [set _(m) [timerate $_(c) $reptime]]
lappend _(itm) $_(m)
puts ""
}
_test_out_total
}
proc test-format {{reptime 1000}} {
_test_run $reptime {
# Format : short, week only (in gmt)
{clock format 1482525936 -format "%u" -gmt 1}
# Format : short, week only (system zone)
{clock format 1482525936 -format "%u"}
# Format : short, week only (CEST)
{clock format 1482525936 -format "%u" -timezone :CET}
# Format : date only (in gmt)
{clock format 1482525936 -format "%Y-%m-%d" -gmt 1}
# Format : date only (system zone)
{clock format 1482525936 -format "%Y-%m-%d"}
# Format : date only (CEST)
{clock format 1482525936 -format "%Y-%m-%d" -timezone :CET}
# Format : time only (in gmt)
{clock format 1482525936 -format "%H:%M" -gmt 1}
# Format : time only (system zone)
{clock format 1482525936 -format "%H:%M"}
# Format : time only (CEST)
{clock format 1482525936 -format "%H:%M" -timezone :CET}
# Format : time only (in gmt)
{clock format 1482525936 -format "%H:%M:%S" -gmt 1}
# Format : time only (system zone)
{clock format 1482525936 -format "%H:%M:%S"}
# Format : time only (CEST)
{clock format 1482525936 -format "%H:%M:%S" -timezone :CET}
# Format : default (in gmt)
{clock format 1482525936 -gmt 1 -locale en}
# Format : default (system zone)
{clock format 1482525936 -locale en}
# Format : default (CEST)
{clock format 1482525936 -timezone :CET -locale en}
# Format : ISO date-time (in gmt, numeric zone)
{clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1}
# Format : ISO date-time (system zone, CEST, numeric zone)
{clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z"}
# Format : ISO date-time (CEST, numeric zone)
{clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -timezone :CET}
# Format : ISO date-time (system zone, CEST)
{clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %Z"}
# Format : julian day with time (in gmt):
{clock format 1246379415 -format "%J %H:%M:%S" -gmt 1}
# Format : julian day with time (system zone):
{clock format 1246379415 -format "%J %H:%M:%S"}
# Format : locale date-time (en):
{clock format 1246379415 -format "%x %X" -locale en}
# Format : locale date-time (de):
{clock format 1246379415 -format "%x %X" -locale de}
# Format : locale lookup table month:
{clock format 1246379400 -format "%b" -locale en -gmt 1}
# Format : locale lookup 2 tables - month and day:
{clock format 1246379400 -format "%b %Od" -locale en -gmt 1}
# Format : locale lookup 3 tables - week, month and day:
{clock format 1246379400 -format "%a %b %Od" -locale en -gmt 1}
# Format : locale lookup 4 tables - week, month, day and year:
{clock format 1246379400 -format "%a %b %Od %Oy" -locale en -gmt 1}
# Format : dynamic clock value (without converter caches):
setup {set i 0}
{clock format [incr i] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET}
cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]}
# Format : dynamic clock value (without any converter caches, zone range overflow):
setup {set i 0}
{clock format [incr i 86400] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET}
cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]}
# Format : dynamic format (cacheable)
{clock format 1246379415 -format [string trim "%d.%m.%Y %H:%M:%S "] -gmt 1}
# Format : all (in gmt, locale en)
{clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -gmt 1 -locale en}
# Format : all (in CET, locale de)
{clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -timezone :CET -locale de}
}
}
proc test-scan {{reptime 1000}} {
_test_run $reptime {
# Scan : date (in gmt)
{clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1}
# Scan : date (system time zone, with base)
{clock scan "25.11.2015" -format "%d.%m.%Y" -base 0}
# Scan : date (system time zone, without base)
{clock scan "25.11.2015" -format "%d.%m.%Y"}
# Scan : greedy match
{clock scan "111" -format "%d%m%y" -base 0 -gmt 1}
{clock scan "1111" -format "%d%m%y" -base 0 -gmt 1}
{clock scan "11111" -format "%d%m%y" -base 0 -gmt 1}
{clock scan "111111" -format "%d%m%y" -base 0 -gmt 1}
# Scan : greedy match (space separated)
{clock scan "1 1 1" -format "%d%m%y" -base 0 -gmt 1}
{clock scan "111 1" -format "%d%m%y" -base 0 -gmt 1}
{clock scan "1 111" -format "%d%m%y" -base 0 -gmt 1}
{clock scan "1 11 1" -format "%d%m%y" -base 0 -gmt 1}
{clock scan "1 11 11" -format "%d%m%y" -base 0 -gmt 1}
{clock scan "11 11 11" -format "%d%m%y" -base 0 -gmt 1}
# Scan : time (in gmt)
{clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000 -gmt 1}
# Scan : time (system time zone, with base)
{clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000}
# Scan : time (gmt, without base)
{clock scan "10:35:55" -format "%H:%M:%S" -gmt 1}
# Scan : time (system time zone, without base)
{clock scan "10:35:55" -format "%H:%M:%S"}
# Scan : date-time (in gmt)
{clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0 -gmt 1}
# Scan : date-time (system time zone with base)
{clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0}
# Scan : date-time (system time zone without base)
{clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S"}
# Scan : julian day in gmt
{clock scan 2451545 -format %J -gmt 1}
# Scan : julian day in system TZ
{clock scan 2451545 -format %J}
# Scan : julian day in other TZ
{clock scan 2451545 -format %J -timezone +0200}
# Scan : julian day with time:
{clock scan "2451545 10:20:30" -format "%J %H:%M:%S"}
# Scan : julian day with time (greedy match):
{clock scan "2451545 102030" -format "%J%H%M%S"}
# Scan : century, lookup table month
{clock scan {1970 Jan 2} -format {%C%y %b %d} -locale en -gmt 1}
# Scan : century, lookup table month and day (both entries are first)
{clock scan {1970 Jan 01} -format {%C%y %b %Od} -locale en -gmt 1}
# Scan : century, lookup table month and day (list scan: entries with position 12 / 31)
{clock scan {2016 Dec 31} -format {%C%y %b %Od} -locale en -gmt 1}
# Scan : ISO date-time (CEST)
{clock scan "2009-06-30T18:30:00+02:00" -format "%Y-%m-%dT%H:%M:%S%z"}
{clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"}
# Scan : ISO date-time (UTC)
{clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S%z"}
{clock scan "2009-06-30T18:30:00 UTC" -format "%Y-%m-%dT%H:%M:%S %z"}
# Scan : locale date-time (en):
{clock scan "06/30/2009 18:30:15" -format "%x %X" -gmt 1 -locale en}
# Scan : locale date-time (de):
{clock scan "30.06.2009 18:30:15" -format "%x %X" -gmt 1 -locale de}
# Scan : dynamic format (cacheable)
{clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1}
break
# # Scan : long format test (allock chain)
# {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1}
# # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc):
# {clock scan "25.11.2015" -format [string repeat "[incr i] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1}
# # Scan : again:
# {clock scan "25.11.2015" -format [string repeat "[incr i -1] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1}
} {puts [clock format $_(r) -locale en]}
}
proc test-freescan {{reptime 1000}} {
_test_run $reptime {
# FreeScan : relative date
{clock scan "5 years 18 months 385 days" -base 0 -gmt 1}
# FreeScan : relative date with relative weekday
{clock scan "5 years 18 months 385 days Fri" -base 0 -gmt 1}
# FreeScan : relative date with ordinal month
{clock scan "5 years 18 months 385 days next 1 January" -base 0 -gmt 1}
# FreeScan : relative date with ordinal month and relative weekday
{clock scan "5 years 18 months 385 days next January Fri" -base 0 -gmt 1}
# FreeScan : ordinal month
{clock scan "next January" -base 0 -gmt 1}
# FreeScan : relative week
{clock scan "next Fri" -base 0 -gmt 1}
# FreeScan : relative weekday and week offset
{clock scan "next January + 2 week" -base 0 -gmt 1}
# FreeScan : time only with base
{clock scan "19:18:30" -base 148863600 -gmt 1}
# FreeScan : time only without base, gmt
{clock scan "19:18:30" -gmt 1}
# FreeScan : time only without base, system
{clock scan "19:18:30"}
# FreeScan : date, system time zone
{clock scan "05/08/2016 20:18:30"}
# FreeScan : date, supplied time zone
{clock scan "05/08/2016 20:18:30" -timezone :CET}
# FreeScan : date, supplied gmt (equivalent -timezone :GMT)
{clock scan "05/08/2016 20:18:30" -gmt 1}
# FreeScan : date, supplied time zone gmt
{clock scan "05/08/2016 20:18:30" -timezone :GMT}
# FreeScan : time only, numeric zone in string, base time gmt (exchange zones between gmt / -0500)
{clock scan "20:18:30 -0500" -base 148863600 -gmt 1}
# FreeScan : time only, zone in string (exchange zones between system / gmt)
{clock scan "19:18:30 GMT" -base 148863600}
# FreeScan : fast switch of zones in cycle - GMT, MST, CET (system) and EST
{clock scan "19:18:30 MST" -base 148863600 -gmt 1
clock scan "19:18:30 EST" -base 148863600
}
} {puts [clock format $_(r) -locale en]}
}
proc test-add {{reptime 1000}} {
_test_run $reptime {
# Add : years
{clock add 1246379415 5 years -gmt 1}
# Add : months
{clock add 1246379415 18 months -gmt 1}
# Add : weeks
{clock add 1246379415 20 weeks -gmt 1}
# Add : days
{clock add 1246379415 385 days -gmt 1}
# Add : weekdays
{clock add 1246379415 3 weekdays -gmt 1}
# Add : hours
{clock add 1246379415 5 hours -gmt 1}
# Add : minutes
{clock add 1246379415 55 minutes -gmt 1}
# Add : seconds
{clock add 1246379415 100 seconds -gmt 1}
# Add : +/- in gmt
{clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -gmt 1}
# Add : +/- in system timezone
{clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -timezone :CET}
# Add : gmt
{clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -gmt 1}
# Add : system timezone
{clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -timezone :CET}
# Add : all in gmt
{clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -gmt 1}
# Add : all in system timezone
{clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -timezone :CET}
} {puts [clock format $_(r) -locale en]}
}
proc test-other {{reptime 1000}} {
_test_run $reptime {
# Bad zone
{catch {clock scan "1 day" -timezone BAD_ZONE -locale en}}
# Scan : julian day (overflow)
{catch {clock scan 5373485 -format %J}}
# Scan : test rotate of GC objects (format is dynamic, so tcl-obj removed with last reference)
{set i 0; time { clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50}
# Scan : test reusability of GC objects (format is dynamic, so tcl-obj removed with last reference)
{set i 50; time { clock scan "[incr i -1] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50}
}
}
proc test-ensemble-perf {{reptime 1000}} {
_test_run $reptime {
# Clock clicks (ensemble)
{clock clicks}
# Clock clicks (direct)
{::tcl::clock::clicks}
# Clock seconds (ensemble)
{clock seconds}
# Clock seconds (direct)
{::tcl::clock::seconds}
# Clock microseconds (ensemble)
{clock microseconds}
# Clock microseconds (direct)
{::tcl::clock::microseconds}
# Clock scan (ensemble)
{clock scan ""}
# Clock scan (direct)
{::tcl::clock::scan ""}
# Clock format (ensemble)
{clock format 0 -f %s}
# Clock format (direct)
{::tcl::clock::format 0 -f %s}
}
}
proc test {{reptime 1000}} {
puts ""
test-ensemble-perf [expr {$reptime / 2}]; #fast enough
test-format $reptime
test-scan $reptime
test-freescan $reptime
test-add $reptime
test-other $reptime
puts \n**OK**
}
test 500; # ms
|
Changes to tests/clock.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
# clock.test --
#
# This test file covers the 'clock' command that manipulates time.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
| > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
# clock.test --
#
# This test file covers the 'clock' command that manipulates time.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
# Copyright (c) 2015 by Sergey G. Brester aka sebres.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
|
| ︙ | ︙ | |||
30 31 32 33 34 35 36 37 38 39 40 41 42 43 |
testConstraint detroit \
[expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}]
testConstraint y2038 \
[expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}]
# TEST PLAN
# clock-1:
# [clock format] - tests of bad and empty arguments
#
# clock-2
# formatting of year, month and day of month
#
# clock-3
| > > > | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 |
testConstraint detroit \
[expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}]
testConstraint y2038 \
[expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}]
# TEST PLAN
# clock-0:
# several base test-cases
#
# clock-1:
# [clock format] - tests of bad and empty arguments
#
# clock-2
# formatting of year, month and day of month
#
# clock-3
|
| ︙ | ︙ | |||
246 247 248 249 250 251 252 253 254 255 256 |
}
if { ![dict exists $reg $path $key] } {
return -code error "test case attempts to read unknown registry entry $path $key"
}
return [dict get $reg $path $key]
}
# Test some of the basics of [clock format]
test clock-1.0 "clock format - wrong # args" {
list [catch {clock format} msg] $msg $::errorCode
| > > > > > > > > > > > > > > > > > > | > > > > > | | > > > > > > > > > > | 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 |
}
if { ![dict exists $reg $path $key] } {
return -code error "test case attempts to read unknown registry entry $path $key"
}
return [dict get $reg $path $key]
}
# Base test cases:
test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" {
set i [interp create]; # because clock can be used somewhere, test it in new interp:
set ret [$i eval {
lappend ret ens:[namespace ensemble exists ::clock]
clock seconds; # init ensemble (but not yet stubs, loading of clock.tcl retarded)
lappend ret ens:[namespace ensemble exists ::clock]
lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}]
clock format -now; # clock.tcl stubs expected
lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}]
}]
interp delete $i
set ret
} {ens:0 ens:1 stubs:0 stubs:1}
# Test some of the basics of [clock format]
test clock-1.0 "clock format - wrong # args" {
list [catch {clock format} msg] $msg $::errorCode
} {1 {wrong # args: should be "clock format clockval|-now ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}}
test clock-1.0.1 "clock format - wrong # args (compiled ensemble with invalid syntax)" {
list [catch {clock format 0 -too-few-options-4-test} msg] $msg $::errorCode
} {1 {wrong # args: should be "clock format clockval|-now ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}}
test clock-1.1 "clock format - bad time" {
list [catch {clock format foo} msg] $msg
} {1 {expected integer but got "foo"}}
test clock-1.2 "clock format - bad gmt val" {
list [catch {clock format 0 -gmt foo} msg] $msg
} {1 {expected boolean value but got "foo"}}
test clock-1.3 "clock format - empty val" {
clock format 0 -gmt 1 -format ""
} {}
test clock-1.4 "clock format - bad flag" {*}{
-body {
# range error message for possible extensions:
list [catch {clock format 0 -oops badflag} msg] [string range $msg 0 60] $::errorCode
}
-match glob
-result {1 {bad option "-oops": must be -format, -gmt, -locale, -timezone} {CLOCK badOption -oops}}
}
test clock-1.5 "clock format - bad timezone" {
list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode
} {1 {time zone ":NOWHERE" not found} {CLOCK badTimeZone :NOWHERE}}
test clock-1.6 "clock format - gmt + timezone" {
list [catch {clock format 0 -timezone :GMT -gmt true} msg] $msg $::errorCode
} {1 {cannot use -gmt and -timezone in same call} {CLOCK gmtWithTimezone}}
test clock-1.7 "clock format - option abbreviations" {
clock format 0 -g true -f "%Y-%m-%d"
} 1970-01-01
test clock-1.8 "clock format -now" {
# give one second more for test (if on boundary of the current second):
set n [clock format [clock seconds] -g 1 -f "%s"]
expr {[clock format -now -g 1 -f "%s"] in [list $n [incr n]]}
} 1
test clock-1.9 "clock arguments: option doubly present" {
list [catch {clock format 0 -gmt 1 -gmt 0} result] $result
} {1 {bad option "-gmt": doubly present}}
# BEGIN testcases2
# Test formatting of Gregorian year, month, day, all formats
# Formats tested: %b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y %EY
test clock-2.1 {conversion of 1872-01-01} {
clock format -3092556304 \
|
| ︙ | ︙ | |||
18549 18550 18551 18552 18553 18554 18555 |
} 2147483648
test clock-6.8 {input of seconds} {
clock scan {9223372036854775807} -format %s -gmt true
} 9223372036854775807
test clock-6.9 {input of seconds - overflow} {
| | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 18586 18587 18588 18589 18590 18591 18592 18593 18594 18595 18596 18597 18598 18599 18600 18601 18602 18603 18604 18605 18606 18607 18608 18609 18610 18611 18612 18613 18614 18615 18616 18617 18618 18619 18620 18621 18622 18623 18624 18625 18626 18627 18628 18629 18630 18631 18632 18633 18634 18635 18636 18637 18638 18639 18640 18641 18642 18643 18644 18645 18646 18647 18648 18649 18650 18651 18652 18653 18654 18655 18656 18657 18658 18659 18660 18661 18662 18663 18664 18665 18666 18667 18668 18669 18670 18671 18672 18673 18674 18675 18676 18677 18678 18679 18680 18681 18682 18683 18684 18685 18686 18687 18688 18689 18690 18691 18692 18693 18694 18695 18696 18697 18698 18699 18700 18701 18702 18703 18704 18705 18706 18707 18708 18709 18710 18711 18712 18713 18714 18715 18716 18717 18718 18719 18720 18721 18722 18723 18724 18725 18726 18727 18728 18729 18730 18731 18732 18733 18734 18735 18736 18737 18738 18739 18740 18741 18742 18743 18744 18745 18746 18747 18748 18749 18750 18751 18752 18753 18754 18755 18756 18757 18758 18759 18760 18761 18762 18763 18764 18765 18766 18767 18768 18769 |
} 2147483648
test clock-6.8 {input of seconds} {
clock scan {9223372036854775807} -format %s -gmt true
} 9223372036854775807
test clock-6.9 {input of seconds - overflow} {
list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result $::errorCode
} {1 {requested date too large to represent} {CLOCK dateTooLarge}}
test clock-6.10 {input of seconds - overflow} {
list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result $::errorCode
} {1 {requested date too large to represent} {CLOCK dateTooLarge}}
test clock-6.11 {input of seconds - two values} {
clock scan {1 2} -format {%s %s} -gmt true
} 2
test clock-6.12 {input of unambiguous short locale token (%b)} {
list [clock scan "12 Ja 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] \
[clock scan "12 Au 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1]
} {979257600 997574400}
test clock-6.13 {input of lowercase locale token (%b)} {
list [clock scan "12 ja 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] \
[clock scan "12 au 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1]
} {979257600 997574400}
test clock-6.14 {input of uppercase locale token (%b)} {
list [clock scan "12 JA 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] \
[clock scan "12 AU 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1]
} {979257600 997574400}
test clock-6.15 {input of ambiguous short locale token (%b)} {
list [catch {
clock scan "12 J 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1
} result] $result $errorCode
} {1 {input string does not match supplied format} {CLOCK badInputString}}
test clock-6.16 {input of ambiguous short locale token (%b)} {
list [catch {
clock scan "12 Ju 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1
} result] $result $errorCode
} {1 {input string does not match supplied format} {CLOCK badInputString}}
test clock-6.17 {spaces are always optional in non-strict mode (default)} {
list [clock scan "2009-06-30T18:30:00+02:00" -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \
[clock scan "2009-06-30T18:30:00 +02:00" -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \
[clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S%z" -timezone CET] \
[clock scan "2009-06-30T18:30:00 Z" -format "%Y-%m-%dT%H:%M:%S%z" -timezone CET]
} {1246379400 1246379400 1246386600 1246386600}
test clock-6.18 {zone token (%z) is optional} {
list [clock scan "2009-06-30T18:30:00 -01:00" -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \
[clock scan "2009-06-30T18:30:00" -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \
[clock scan " 2009-06-30T18:30:00 " -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \
} {1246390200 1246386600 1246386600}
test clock-6.19 {no token parsing} {
list [catch { clock scan "%E%O%" -format "%E%O%" }] \
[catch { clock scan "...%..." -format "...%%..." }]
} {0 0}
test clock-6.20 {special char tokens %n, %t} {
clock scan "30\t06\t2009\n18\t30" -format "%d%t%m%t%Y%n%H%t%M" -gmt 1
} 1246386600
# Hi, Jeff!
proc _testStarDates {s {days {366*2}} {step {86400}}} {
set step [expr {int($step * 86400)}]
# reconvert - arrange in order of stardate:
set s [set i [clock scan [clock format $s -f "%Q" -g 1] -g 1]]
# test:
set wrong {}
while {$i < $s + $days*86400} {
set d [clock format $i -f "%Q" -g 1]
if {![regexp {^Stardate \d+\.\d$} $d]} {
lappend wrong "wrong: $d -- ($i) -- [clock format $i -g 1]"
}
if {[catch {
set i2 [clock scan $d -f "%Q" -g 1]
} msg]} {
lappend wrong "$d -- ($i) -- [clock format $i -g 1]: $msg"
}
if {$i != $i2} {
lappend wrong "$d -- ($i != $i2) -- [clock format $i -g 1]"
}
incr i $step
}
join $wrong \n
}
test clock-6.21.0 {Stardate 0 day} {
list [set d [clock format -757382400 -format "%Q" -gmt 1]] \
[clock scan $d -format "%Q" -gmt 1]
} [list "Stardate 00000.0" -757382400]
test clock-6.21.0.1 {Stardate 0.1 - 1.9 (test negative clock value -> positive Stardate)} {
_testStarDates -757382400 2 0.1
} {}
test clock-6.21.0.2 {Stardate 10000.1 - 10002.9 (test negative clock value -> positive Stardate)} {
_testStarDates [clock scan "Stardate 10000.1" -f %Q -g 1] 3 0.1
} {}
test clock-6.21.0.2 {Stardate 80000.1 - 80002.9 (test positive clock value)} {
_testStarDates [clock scan "Stardate 80001.1" -f %Q -g 1] 3 0.1
} {}
test clock-6.21.1 {Stardate} {
list [set d [clock format 1482857280 -format "%Q" -gmt 1]] \
[clock scan $d -format "%Q" -gmt 1]
} [list "Stardate 70986.7" 1482857280]
test clock-6.21.2 {Stardate next time} {
list [set d [clock format 1482865920 -format "%Q" -gmt 1]] \
[clock scan $d -format "%Q" -gmt 1]
} [list "Stardate 70986.8" 1482865920]
test clock-6.21.3 {Stardate correct scan over year (leap year, begin, middle and end of the year)} {
_testStarDates [clock scan "01.01.2016" -f "%d.%m.%Y" -g 1] [expr {366*2}] 1
} {}
rename _testStarDates {}
test clock-6.22.1 {Greedy match} {
clock format [clock scan "111" -format "%d%m%y" -gmt 1] -locale en -gmt 1
} {Mon Jan 01 00:00:00 GMT 2001}
test clock-6.22.2 {Greedy match} {
clock format [clock scan "1111" -format "%d%m%y" -gmt 1] -locale en -gmt 1
} {Thu Jan 11 00:00:00 GMT 2001}
test clock-6.22.3 {Greedy match} {
clock format [clock scan "11111" -format "%d%m%y" -gmt 1] -locale en -gmt 1
} {Sun Nov 11 00:00:00 GMT 2001}
test clock-6.22.4 {Greedy match} {
clock format [clock scan "111111" -format "%d%m%y" -gmt 1] -locale en -gmt 1
} {Fri Nov 11 00:00:00 GMT 2011}
test clock-6.22.5 {Greedy match} {
clock format [clock scan "1 1 1" -format "%d%m%y" -gmt 1] -locale en -gmt 1
} {Mon Jan 01 00:00:00 GMT 2001}
test clock-6.22.6 {Greedy match} {
clock format [clock scan "111 1" -format "%d%m%y" -gmt 1] -locale en -gmt 1
} {Thu Jan 11 00:00:00 GMT 2001}
test clock-6.22.7 {Greedy match} {
clock format [clock scan "1 111" -format "%d%m%y" -gmt 1] -locale en -gmt 1
} {Thu Nov 01 00:00:00 GMT 2001}
test clock-6.22.8 {Greedy match} {
clock format [clock scan "1 11 1" -format "%d%m%y" -gmt 1] -locale en -gmt 1
} {Thu Nov 01 00:00:00 GMT 2001}
test clock-6.22.9 {Greedy match} {
clock format [clock scan "1 11 11" -format "%d%m%y" -gmt 1] -locale en -gmt 1
} {Tue Nov 01 00:00:00 GMT 2011}
test clock-6.22.10 {Greedy match} {
clock format [clock scan "11 11 11" -format "%d%m%y" -gmt 1] -locale en -gmt 1
} {Fri Nov 11 00:00:00 GMT 2011}
test clock-6.22.11 {Greedy match} {
clock format [clock scan "1111 120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
} {Sat Jan 01 01:02:00 GMT 2011}
test clock-6.22.12 {Greedy match} {
clock format [clock scan "11 1 120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
} {Mon Jan 01 01:02:00 GMT 2001}
test clock-6.22.13 {Greedy match} {
clock format [clock scan "1 11 120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
} {Mon Jan 01 01:02:00 GMT 2001}
test clock-6.22.14 {Greedy match} {
clock format [clock scan "111120" -format "%y%m%d%H%M%S" -gmt 1] -locale en -gmt 1
} {Mon Jan 01 01:02:00 GMT 2001}
test clock-6.22.15 {Greedy match} {
clock format [clock scan "1111120" -format "%y%m%d%H%M%S" -gmt 1] -locale en -gmt 1
} {Sat Jan 01 01:02:00 GMT 2011}
test clock-6.22.16 {Greedy match} {
clock format [clock scan "11121120" -format "%y%m%d%H%M%S" -gmt 1] -locale en -gmt 1
} {Thu Dec 01 01:02:00 GMT 2011}
test clock-6.22.17 {Greedy match} {
clock format [clock scan "111213120" -format "%y%m%d%H%M%S" -gmt 1] -locale en -gmt 1
} {Tue Dec 13 01:02:00 GMT 2011}
test clock-6.22.17 {Greedy match (space wins as date-time separator)} {
clock format [clock scan "1112 13120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
} {Sun Jan 02 13:12:00 GMT 2011}
test clock-6.22.18 {Greedy match (second space wins as date-time separator)} {
clock format [clock scan "1112 13 120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
} {Tue Dec 13 01:02:00 GMT 2011}
test clock-6.22.19 {Greedy match (space wins as date-time separator)} {
clock format [clock scan "111 213120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
} {Mon Jan 01 21:31:20 GMT 2001}
test clock-6.22.20 {Greedy match (second space wins as date-time separator)} {
clock format [clock scan "111 2 13120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
} {Sun Jan 02 13:12:00 GMT 2011}
test clock-7.1 {Julian Day} {
clock scan 0 -format %J -gmt true
} -210866803200
test clock-7.2 {Julian Day} {
clock format [clock scan 2440588 -format %J -gmt true] \
|
| ︙ | ︙ | |||
21066 21067 21068 21069 21070 21071 21072 |
test clock-10.10 {julian day takes precedence over ccyyddd} {
list [clock scan {2440588 2000001} -format {%J %Y%j} -gmt true] \
[clock scan {2000001 2440588} -format {%Y%j %J} -gmt true]
} {0 0}
# BEGIN testcases11
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 21263 21264 21265 21266 21267 21268 21269 21270 21271 21272 21273 21274 21275 21276 21277 21278 21279 21280 21281 21282 21283 21284 21285 21286 21287 21288 21289 21290 21291 21292 21293 21294 21295 21296 21297 21298 21299 21300 21301 21302 21303 21304 21305 21306 21307 21308 21309 21310 21311 21312 21313 21314 21315 21316 21317 21318 21319 21320 21321 21322 21323 21324 21325 21326 21327 21328 21329 21330 21331 21332 21333 21334 21335 21336 21337 21338 21339 21340 21341 21342 21343 21344 21345 21346 21347 21348 |
test clock-10.10 {julian day takes precedence over ccyyddd} {
list [clock scan {2440588 2000001} -format {%J %Y%j} -gmt true] \
[clock scan {2000001 2440588} -format {%Y%j %J} -gmt true]
} {0 0}
# BEGIN testcases11
# Test precedence yyyymmdd over yyyyddd
test clock-11.1 {precedence of ccyymmdd over ccyyddd} {
clock scan 19700101002 -format %Y%m%d%j -gmt 1
} 0
test clock-11.2 {precedence of ccyymmdd over ccyyddd} {
clock scan 01197001002 -format %m%Y%d%j -gmt 1
} 0
test clock-11.3 {precedence of ccyymmdd over ccyyddd} {
clock scan 01197001002 -format %d%Y%m%j -gmt 1
} 0
test clock-11.4 {precedence of ccyymmdd over ccyyddd} {
clock scan 00219700101 -format %j%Y%m%d -gmt 1
} 0
test clock-11.5 {precedence of ccyymmdd over ccyyddd} {
clock scan 19700100201 -format %Y%m%j%d -gmt 1
} 0
test clock-11.6 {precedence of ccyymmdd over ccyyddd} {
clock scan 01197000201 -format %m%Y%j%d -gmt 1
} 0
test clock-11.7 {precedence of ccyymmdd over ccyyddd} {
clock scan 01197000201 -format %d%Y%j%m -gmt 1
} 0
test clock-11.8 {precedence of ccyymmdd over ccyyddd} {
clock scan 00219700101 -format %j%Y%d%m -gmt 1
} 0
test clock-11.9 {precedence of ccyymmdd over ccyyddd} {
clock scan 19700101002 -format %Y%d%m%j -gmt 1
} 0
test clock-11.10 {precedence of ccyymmdd over ccyyddd} {
clock scan 01011970002 -format %m%d%Y%j -gmt 1
} 0
test clock-11.11 {precedence of ccyymmdd over ccyyddd} {
clock scan 01011970002 -format %d%m%Y%j -gmt 1
} 0
test clock-11.12 {precedence of ccyymmdd over ccyyddd} {
clock scan 00201197001 -format %j%m%Y%d -gmt 1
} 0
test clock-11.13 {precedence of ccyymmdd over ccyyddd} {
clock scan 19700100201 -format %Y%d%j%m -gmt 1
} 0
test clock-11.14 {precedence of ccyymmdd over ccyyddd} {
clock scan 01010021970 -format %m%d%j%Y -gmt 1
} 0
test clock-11.15 {precedence of ccyymmdd over ccyyddd} {
clock scan 01010021970 -format %d%m%j%Y -gmt 1
} 0
test clock-11.16 {precedence of ccyymmdd over ccyyddd} {
clock scan 00201011970 -format %j%m%d%Y -gmt 1
} 0
test clock-11.17 {precedence of ccyymmdd over ccyyddd} {
clock scan 19700020101 -format %Y%j%m%d -gmt 1
} 0
test clock-11.18 {precedence of ccyymmdd over ccyyddd} {
clock scan 01002197001 -format %m%j%Y%d -gmt 1
} 0
test clock-11.19 {precedence of ccyymmdd over ccyyddd} {
clock scan 01002197001 -format %d%j%Y%m -gmt 1
} 0
test clock-11.20 {precedence of ccyymmdd over ccyyddd} {
clock scan 00201197001 -format %j%d%Y%m -gmt 1
} 0
test clock-11.21 {precedence of ccyymmdd over ccyyddd} {
clock scan 19700020101 -format %Y%j%d%m -gmt 1
} 0
test clock-11.22 {precedence of ccyymmdd over ccyyddd} {
clock scan 01002011970 -format %m%j%d%Y -gmt 1
} 0
test clock-11.23 {precedence of ccyymmdd over ccyyddd} {
clock scan 01002011970 -format %d%j%m%Y -gmt 1
} 0
test clock-11.24 {precedence of ccyymmdd over ccyyddd} {
clock scan 00201011970 -format %j%d%m%Y -gmt 1
} 0
# END testcases11
# BEGIN testcases12
# Test parsing of ccyyWwwd
|
| ︙ | ︙ | |||
35658 35659 35660 35661 35662 35663 35664 |
} {Oct 23,1992 15:00 GMT}
test clock-34.8 {clock scan tests} {
set time [clock scan "Oct 23,1992 15:00" -gmt true]
clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
} {Oct 23,1992 15:00 GMT}
test clock-34.9 {clock scan tests} {
list [catch {clock scan "Jan 12" -bad arg} msg] $msg
| | | > > > > > > > > | 35855 35856 35857 35858 35859 35860 35861 35862 35863 35864 35865 35866 35867 35868 35869 35870 35871 35872 35873 35874 35875 35876 35877 35878 35879 35880 35881 35882 35883 35884 35885 35886 35887 |
} {Oct 23,1992 15:00 GMT}
test clock-34.8 {clock scan tests} {
set time [clock scan "Oct 23,1992 15:00" -gmt true]
clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
} {Oct 23,1992 15:00 GMT}
test clock-34.9 {clock scan tests} {
list [catch {clock scan "Jan 12" -bad arg} msg] $msg
} {1 {bad option "-bad": must be -format, -gmt, -locale, -timezone, or -base}}
# The following two two tests test the two year date policy
test clock-34.10 {clock scan tests} {
set time [clock scan "1/1/71" -gmt true]
clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
} {Jan 01,1971 00:00 GMT}
test clock-34.11 {clock scan tests} {
set time [clock scan "1/1/37" -gmt true]
clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
} {Jan 01,2037 00:00 GMT}
test clock-34.11.1 {clock scan tests: same century switch} {
set times [clock scan "1/1/37" -gmt true]
} [clock scan "1/1/37" -format "%m/%d/%y" -gmt true]
test clock-34.11.2 {clock scan tests: same century switch} {
set times [clock scan "1/1/38" -gmt true]
} [clock scan "1/1/38" -format "%m/%d/%y" -gmt true]
test clock-34.11.3 {clock scan tests: same century switch} {
set times [clock scan "1/1/39" -gmt true]
} [clock scan "1/1/39" -format "%m/%d/%y" -gmt true]
test clock-34.12 {clock scan, relative times} {
set time [clock scan "Oct 23, 1992 -1 day"]
clock format $time -format {%b %d, %Y}
} "Oct 22, 1992"
test clock-34.13 {clock scan, ISO 8601 base date format} {
set time [clock scan "19921023"]
clock format $time -format {%b %d, %Y}
|
| ︙ | ︙ | |||
35791 35792 35793 35794 35795 35796 35797 35798 35799 35800 35801 35802 35803 35804 |
clock format [clock scan "thursday" -base [clock scan 20000112]] \
-format {%b %d, %Y}
} "Jan 13, 2000"
test clock-34.40 {clock scan, next day of week} {
clock format [clock scan "next thursday" -base [clock scan 20000112]] \
-format {%b %d, %Y}
} "Jan 20, 2000"
# weekday specification and base.
test clock-34.41 {2nd monday in november} {
set res {}
foreach i {91 92 93 94 95 96} {
set nov8th [clock scan 11/8/$i]
set monday [clock scan monday -base $nov8th]
| > > > > > > > > > > > > > > > > > > > > > | 35996 35997 35998 35999 36000 36001 36002 36003 36004 36005 36006 36007 36008 36009 36010 36011 36012 36013 36014 36015 36016 36017 36018 36019 36020 36021 36022 36023 36024 36025 36026 36027 36028 36029 36030 |
clock format [clock scan "thursday" -base [clock scan 20000112]] \
-format {%b %d, %Y}
} "Jan 13, 2000"
test clock-34.40 {clock scan, next day of week} {
clock format [clock scan "next thursday" -base [clock scan 20000112]] \
-format {%b %d, %Y}
} "Jan 20, 2000"
test clock-34.40.1 {clock scan, ordinal month after relative date} {
# This will fail without the bug fix (clock.tcl), as still missing
# month/julian day conversion before ordinal month increment
clock format [ \
clock scan "5 years 18 months 387 days" -base 0 -gmt 1
] -format {%a, %b %d, %Y} -gmt 1 -locale en_US_roman
} "Sat, Jul 23, 1977"
test clock-34.40.2 {clock scan, ordinal month after relative date} {
# This will fail without the bug fix (clock.tcl), as still missing
# month/julian day conversion before ordinal month increment
clock format [ \
clock scan "5 years 18 months 387 days next Jan" -base 0 -gmt 1
] -format {%a, %b %d, %Y} -gmt 1 -locale en_US_roman
} "Mon, Jan 23, 1978"
test clock-34.40.3 {clock scan, day of week after ordinal date} {
# This will fail without the bug fix (clock.tcl), because the relative
# week day should be applied after whole date conversion
clock format [ \
clock scan "5 years 18 months 387 days next January Fri" -base 0 -gmt 1
] -format {%a, %b %d, %Y} -gmt 1 -locale en_US_roman
} "Fri, Jan 27, 1978"
# weekday specification and base.
test clock-34.41 {2nd monday in november} {
set res {}
foreach i {91 92 93 94 95 96} {
set nov8th [clock scan 11/8/$i]
set monday [clock scan monday -base $nov8th]
|
| ︙ | ︙ | |||
35884 35885 35886 35887 35888 35889 35890 35891 35892 35893 35894 35895 35896 35897 35898 |
test clock-34.52 {more than one ordinal month} {*}{
-body {clock scan {next January next March}}
-returnCodes error
-result {unable to convert date-time string "next January next March": more than one ordinal month in string}
}
# clock seconds
test clock-35.1 {clock seconds tests} {
expr [clock seconds]+1
concat {}
} {}
test clock-35.2 {clock seconds tests} {
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 36110 36111 36112 36113 36114 36115 36116 36117 36118 36119 36120 36121 36122 36123 36124 36125 36126 36127 36128 36129 36130 36131 36132 36133 36134 36135 36136 36137 36138 36139 36140 36141 36142 36143 36144 36145 36146 36147 36148 36149 36150 36151 36152 36153 36154 36155 36156 36157 36158 36159 36160 36161 36162 36163 36164 36165 36166 36167 36168 36169 36170 36171 36172 36173 36174 36175 36176 36177 36178 36179 36180 36181 36182 36183 36184 36185 36186 36187 36188 36189 36190 36191 36192 36193 36194 36195 36196 36197 36198 36199 36200 36201 36202 36203 36204 36205 36206 36207 36208 36209 36210 36211 |
test clock-34.52 {more than one ordinal month} {*}{
-body {clock scan {next January next March}}
-returnCodes error
-result {unable to convert date-time string "next January next March": more than one ordinal month in string}
}
test clock-34.53.1 {relative from base, date switch} {
set base [clock scan "12/31/2016 23:59:59" -gmt 1]
clock format [clock scan "+1 second" \
-base $base -gmt 1] -gmt 1 -format {%Y-%m-%d %H:%M:%S}
} {2017-01-01 00:00:00}
test clock-34.53.2 {relative time, daylight switch} {
set base [clock scan "03/27/2016" -timezone CET]
set res {}
lappend res [clock format [clock scan "+1 hour" \
-base $base -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]
lappend res [clock format [clock scan "+2 hour" \
-base $base -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]
} {{2016-03-27 01:00:00 CET} {2016-03-27 03:00:00 CEST}}
test clock-34.53.3 {relative time with day increment / daylight switch} {
set base [clock scan "03/27/2016" -timezone CET]
set res {}
lappend res [clock format [clock scan "+5 day +25 hour" \
-base [expr {$base - 6*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]
lappend res [clock format [clock scan "+5 day +26 hour" \
-base [expr {$base - 6*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]
} {{2016-03-27 01:00:00 CET} {2016-03-27 03:00:00 CEST}}
test clock-34.53.4 {relative time with month & day increment / daylight switch} {
set base [clock scan "03/27/2016" -timezone CET]
set res {}
lappend res [clock format [clock scan "next Mar +5 day +25 hour" \
-base [expr {$base - 35*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]
lappend res [clock format [clock scan "next Mar +5 day +26 hour" \
-base [expr {$base - 35*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]
} {{2016-03-27 01:00:00 CET} {2016-03-27 03:00:00 CEST}}
test clock-34.54.1 {check date in DST-hole: daylight switch CET -> CEST} {
set res {}
# forwards
set base 1459033200
for {set i 0} {$i <= 3} {incr i} {
set d [clock scan "+$i hour" -base $base -timezone CET]
lappend res "$d = [clock format $d -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]"
}
lappend res "#--"
# backwards
set base 1459044000
for {set i 0} {$i <= 3} {incr i} {
set d [clock scan "-$i hour" -base $base -timezone CET]
lappend res "$d = [clock format $d -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]"
}
set res
} [split [regsub -all {^\n|\n$} {
1459033200 = 2016-03-27 00:00:00 CET
1459036800 = 2016-03-27 01:00:00 CET
1459040400 = 2016-03-27 03:00:00 CEST
1459044000 = 2016-03-27 04:00:00 CEST
#--
1459044000 = 2016-03-27 04:00:00 CEST
1459040400 = 2016-03-27 03:00:00 CEST
1459036800 = 2016-03-27 01:00:00 CET
1459033200 = 2016-03-27 00:00:00 CET
} {}] \n]
test clock-34.54.2 {check date in DST-hole: daylight switch CEST -> CET} {
set res {}
# forwards
set base 1477782000
for {set i 0} {$i <= 3} {incr i} {
set d [clock scan "+$i hour" -base $base -timezone CET]
lappend res "$d = [clock format $d -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]"
}
lappend res "#--"
# backwards
set base 1477792800
for {set i 0} {$i <= 3} {incr i} {
set d [clock scan "-$i hour" -base $base -timezone CET]
lappend res "$d = [clock format $d -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]"
}
set res
} [split [regsub -all {^\n|\n$} {
1477782000 = 2016-10-30 01:00:00 CEST
1477785600 = 2016-10-30 02:00:00 CEST
1477789200 = 2016-10-30 02:00:00 CET
1477792800 = 2016-10-30 03:00:00 CET
#--
1477792800 = 2016-10-30 03:00:00 CET
1477789200 = 2016-10-30 02:00:00 CET
1477785600 = 2016-10-30 02:00:00 CEST
1477782000 = 2016-10-30 01:00:00 CEST
} {}] \n]
# clock seconds
test clock-35.1 {clock seconds tests} {
expr [clock seconds]+1
concat {}
} {}
test clock-35.2 {clock seconds tests} {
|
| ︙ | ︙ | |||
35916 35917 35918 35919 35920 35921 35922 |
} "07.2000"
test clock-36.3 {clock scan next monthname} {
clock format [clock scan "next may" -base [clock scan "june 1, 2000"]] \
-format %m.%Y
} "05.2001"
test clock-37.1 {%s gmt testing} {
| | > > | | > > > > > > > > > > > > > > > > > > | 36229 36230 36231 36232 36233 36234 36235 36236 36237 36238 36239 36240 36241 36242 36243 36244 36245 36246 36247 36248 36249 36250 36251 36252 36253 36254 36255 36256 36257 36258 36259 36260 36261 36262 36263 36264 36265 36266 36267 36268 36269 |
} "07.2000"
test clock-36.3 {clock scan next monthname} {
clock format [clock scan "next may" -base [clock scan "june 1, 2000"]] \
-format %m.%Y
} "05.2001"
test clock-37.1 {%s gmt testing} {
set s [clock scan "2017-05-10 09:00:00" -gmt 1]
set a [clock format $s -format %s -gmt 0]
set b [clock format $s -format %s -gmt 1]
set c [clock scan $s -format %s -gmt 0]
set d [clock scan $s -format %s -gmt 1]
# %s, being the difference between local and Greenwich, does not
# depend on the time zone.
list [expr {$b-$a}] [expr {$d-$c}]
} {0 0}
test clock-37.2 {%Es gmt testing CET} {
set s [clock scan "2017-01-10 09:00:00" -gmt 1]
set a [clock format $s -format %Es -timezone CET]
set b [clock format $s -format %Es -gmt 1]
set c [clock scan $s -format %Es -timezone CET]
set d [clock scan $s -format %Es -gmt 1]
# %Es depend on the time zone (local seconds instead of posix seconds).
list [expr {$b-$a}] [expr {$d-$c}]
} {-3600 3600}
test clock-37.3 {%Es gmt testing CEST} {
set s [clock scan "2017-05-10 09:00:00" -gmt 1]
set a [clock format $s -format %Es -timezone CET]
set b [clock format $s -format %Es -gmt 1]
set c [clock scan $s -format %Es -timezone CET]
set d [clock scan $s -format %Es -gmt 1]
# %Es depend on the time zone (local seconds instead of posix seconds).
list [expr {$b-$a}] [expr {$d-$c}]
} {-7200 7200}
test clock-38.1 {regression - convertUTCToLocalViaC - east of Greenwich} \
-setup {
if { [info exists env(TZ)] } {
set oldTZ $env(TZ)
}
set env(TZ) CET-01:00CEST-02:00,M3.5.0/02:00,M10.5.0/03:00
|
| ︙ | ︙ |
Changes to tests/encoding.test.
| ︙ | ︙ | |||
448 449 450 451 452 453 454 455 456 457 458 459 460 461 |
set f [open "|[list [interpreter] $file]"]
fconfigure $f -encoding iso2022-jp
set count [gets $f line]
close $f
removeFile iso2022.tcl
list $count [viewable $line]
} [list 3 "\u4e4e\u4e5e\u4e5f (\\u4e4e\\u4e5e\\u4e5f)"]
file delete [file join [temporaryDirectory] iso2022.txt]
#
# Begin jajp encoding round-trip conformity tests
#
proc foreach-jisx0208 {varName command} {
| > > > > > > > > > > > > > > > > > > > > > > > > > | 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 |
set f [open "|[list [interpreter] $file]"]
fconfigure $f -encoding iso2022-jp
set count [gets $f line]
close $f
removeFile iso2022.tcl
list $count [viewable $line]
} [list 3 "\u4e4e\u4e5e\u4e5f (\\u4e4e\\u4e5e\\u4e5f)"]
test encoding-24.4 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xc0\x80"]
} 1
test encoding-24.5 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xc0\x81"]
} 2
test encoding-24.6 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xc1\xbf"]
} 2
test encoding-24.7 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xc2\x80"]
} 1
test encoding-24.8 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xe0\x80\x80"]
} 3
test encoding-24.9 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xe0\x9f\xbf"]
} 3
test encoding-24.10 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xe0\xa0\x80"]
} 1
test encoding-24.10 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xef\xbf\xbf"]
} 1
file delete [file join [temporaryDirectory] iso2022.txt]
#
# Begin jajp encoding round-trip conformity tests
#
proc foreach-jisx0208 {varName command} {
|
| ︙ | ︙ |
Changes to unix/Makefile.in.
| ︙ | ︙ | |||
288 289 290 291 292 293 294 | tclThreadTest.o tclUnixTest.o XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclAssembly.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \ | | | | 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 | tclThreadTest.o tclUnixTest.o XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclAssembly.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \ tclClock.o tclClockFmt.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \ tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \ tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \ tclEncoding.o tclEnsemble.o \ tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \ tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \ tclIORChan.o tclIORTrans.o tclIOGT.o tclIOSock.o tclIOUtil.o \ tclLink.o tclListObj.o \ tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \ tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \ tclPkg.o tclPkgConfig.o tclPosixStr.o \ tclPreserve.o tclProc.o tclRegexp.o \ tclResolve.o tclResult.o tclScan.o tclStringObj.o tclStrIdxTree.o \ tclStrToD.o tclThread.o \ tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \ tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \ tclTomMathInterface.o OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \ tclOOMethod.o tclOOStubInit.o |
| ︙ | ︙ | |||
392 393 394 395 396 397 398 399 400 401 402 403 404 405 | $(GENERIC_DIR)/tclAlloc.c \ $(GENERIC_DIR)/tclAssembly.c \ $(GENERIC_DIR)/tclAsync.c \ $(GENERIC_DIR)/tclBasic.c \ $(GENERIC_DIR)/tclBinary.c \ $(GENERIC_DIR)/tclCkalloc.c \ $(GENERIC_DIR)/tclClock.c \ $(GENERIC_DIR)/tclCmdAH.c \ $(GENERIC_DIR)/tclCmdIL.c \ $(GENERIC_DIR)/tclCmdMZ.c \ $(GENERIC_DIR)/tclCompCmds.c \ $(GENERIC_DIR)/tclCompCmdsGR.c \ $(GENERIC_DIR)/tclCompCmdsSZ.c \ $(GENERIC_DIR)/tclCompExpr.c \ | > | 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 | $(GENERIC_DIR)/tclAlloc.c \ $(GENERIC_DIR)/tclAssembly.c \ $(GENERIC_DIR)/tclAsync.c \ $(GENERIC_DIR)/tclBasic.c \ $(GENERIC_DIR)/tclBinary.c \ $(GENERIC_DIR)/tclCkalloc.c \ $(GENERIC_DIR)/tclClock.c \ $(GENERIC_DIR)/tclClockFmt.c \ $(GENERIC_DIR)/tclCmdAH.c \ $(GENERIC_DIR)/tclCmdIL.c \ $(GENERIC_DIR)/tclCmdMZ.c \ $(GENERIC_DIR)/tclCompCmds.c \ $(GENERIC_DIR)/tclCompCmdsGR.c \ $(GENERIC_DIR)/tclCompCmdsSZ.c \ $(GENERIC_DIR)/tclCompExpr.c \ |
| ︙ | ︙ | |||
446 447 448 449 450 451 452 453 454 455 456 457 458 459 | $(GENERIC_DIR)/tclProc.c \ $(GENERIC_DIR)/tclRegexp.c \ $(GENERIC_DIR)/tclResolve.c \ $(GENERIC_DIR)/tclResult.c \ $(GENERIC_DIR)/tclScan.c \ $(GENERIC_DIR)/tclStubInit.c \ $(GENERIC_DIR)/tclStringObj.c \ $(GENERIC_DIR)/tclStrToD.c \ $(GENERIC_DIR)/tclTest.c \ $(GENERIC_DIR)/tclTestObj.c \ $(GENERIC_DIR)/tclTestProcBodyObj.c \ $(GENERIC_DIR)/tclThread.c \ $(GENERIC_DIR)/tclThreadAlloc.c \ $(GENERIC_DIR)/tclThreadJoin.c \ | > | 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 | $(GENERIC_DIR)/tclProc.c \ $(GENERIC_DIR)/tclRegexp.c \ $(GENERIC_DIR)/tclResolve.c \ $(GENERIC_DIR)/tclResult.c \ $(GENERIC_DIR)/tclScan.c \ $(GENERIC_DIR)/tclStubInit.c \ $(GENERIC_DIR)/tclStringObj.c \ $(GENERIC_DIR)/tclStrIdxTree.c \ $(GENERIC_DIR)/tclStrToD.c \ $(GENERIC_DIR)/tclTest.c \ $(GENERIC_DIR)/tclTestObj.c \ $(GENERIC_DIR)/tclTestProcBodyObj.c \ $(GENERIC_DIR)/tclThread.c \ $(GENERIC_DIR)/tclThreadAlloc.c \ $(GENERIC_DIR)/tclThreadJoin.c \ |
| ︙ | ︙ | |||
1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 | tclCkalloc.o: $(GENERIC_DIR)/tclCkalloc.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCkalloc.c tclClock.o: $(GENERIC_DIR)/tclClock.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClock.c tclCmdAH.o: $(GENERIC_DIR)/tclCmdAH.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdAH.c tclCmdIL.o: $(GENERIC_DIR)/tclCmdIL.c $(TCLREHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdIL.c tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c $(TCLREHDRS) $(TRIMHDR) | > > > | 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 | tclCkalloc.o: $(GENERIC_DIR)/tclCkalloc.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCkalloc.c tclClock.o: $(GENERIC_DIR)/tclClock.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClock.c tclClockFmt.o: $(GENERIC_DIR)/tclClockFmt.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClockFmt.c tclCmdAH.o: $(GENERIC_DIR)/tclCmdAH.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdAH.c tclCmdIL.o: $(GENERIC_DIR)/tclCmdIL.c $(TCLREHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdIL.c tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c $(TCLREHDRS) $(TRIMHDR) |
| ︙ | ︙ | |||
1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 | $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclResult.c tclScan.o: $(GENERIC_DIR)/tclScan.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclScan.c tclStringObj.o: $(GENERIC_DIR)/tclStringObj.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStringObj.c tclStrToD.o: $(GENERIC_DIR)/tclStrToD.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStrToD.c tclStubInit.o: $(GENERIC_DIR)/tclStubInit.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStubInit.c | > > > | 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 | $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclResult.c tclScan.o: $(GENERIC_DIR)/tclScan.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclScan.c tclStringObj.o: $(GENERIC_DIR)/tclStringObj.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStringObj.c tclStrIdxTree.o: $(GENERIC_DIR)/tclStrIdxTree.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStrIdxTree.c tclStrToD.o: $(GENERIC_DIR)/tclStrToD.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStrToD.c tclStubInit.o: $(GENERIC_DIR)/tclStubInit.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStubInit.c |
| ︙ | ︙ |
Changes to unix/configure.
| ︙ | ︙ | |||
5081 5082 5083 5084 5085 5086 5087 |
STLIB_LD='${AR} cr'
LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
PLAT_OBJS=""
PLAT_SRCS=""
LDAIX_SRC=""
if test "x${SHLIB_VERSION}" = x; then :
| | < < | 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 |
STLIB_LD='${AR} cr'
LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
PLAT_OBJS=""
PLAT_SRCS=""
LDAIX_SRC=""
if test "x${SHLIB_VERSION}" = x; then :
SHLIB_VERSION="1.0"
fi
case $system in
AIX-*)
if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then :
# AIX requires the _r compiler when gcc isn't being used
case "${CC}" in
|
| ︙ | ︙ | |||
9962 9963 9964 9965 9966 9967 9968 |
system=$tcl_cv_sys_version
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5
$as_echo_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... " >&6; }
case $system in
OSF*)
| < < < < < < < | 9960 9961 9962 9963 9964 9965 9966 9967 9968 9969 9970 9971 9972 9973 |
system=$tcl_cv_sys_version
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5
$as_echo_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... " >&6; }
case $system in
OSF*)
$as_echo "#define USE_FIONBIO 1" >>confdefs.h
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5
$as_echo "FIONBIO" >&6; }
;;
*)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: O_NONBLOCK" >&5
|
| ︙ | ︙ |
Changes to unix/tcl.m4.
| ︙ | ︙ | |||
967 968 969 970 971 972 973 |
# into a shared library.
# SHLIB_LD_LIBS - Dependent libraries for the linker to scan when
# creating shared libraries. This symbol typically
# goes at the end of the "ld" commands that build
# shared libraries. The value of the symbol defaults to
# "${LIBS}" if all of the dependent libraries should
# be specified when creating a shared library. If
| | | | 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 |
# into a shared library.
# SHLIB_LD_LIBS - Dependent libraries for the linker to scan when
# creating shared libraries. This symbol typically
# goes at the end of the "ld" commands that build
# shared libraries. The value of the symbol defaults to
# "${LIBS}" if all of the dependent libraries should
# be specified when creating a shared library. If
# dependent libraries should not be specified (as on some
# SunOS systems, where they cause the link to fail, or in
# general if Tcl and Tk aren't themselves shared
# libraries), then this symbol has an empty string
# as its value.
# SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable
# extensions. An empty string means we don't know how
# to use shared libraries on this platform.
# TCL_SHLIB_LD_EXTRAS - Additional element which are added to SHLIB_LD_LIBS
|
| ︙ | ︙ | |||
1094 1095 1096 1097 1098 1099 1100 |
])
AC_CHECK_TOOL(AR, ar)
STLIB_LD='${AR} cr'
LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
PLAT_OBJS=""
PLAT_SRCS=""
LDAIX_SRC=""
| | | 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 |
])
AC_CHECK_TOOL(AR, ar)
STLIB_LD='${AR} cr'
LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
PLAT_OBJS=""
PLAT_SRCS=""
LDAIX_SRC=""
AS_IF([test "x${SHLIB_VERSION}" = x], [SHLIB_VERSION="1.0"])
case $system in
AIX-*)
AS_IF([test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"], [
# AIX requires the _r compiler when gcc isn't being used
case "${CC}" in
*_r|*_r\ *)
# ok ...
|
| ︙ | ︙ | |||
2215 2216 2217 2218 2219 2220 2221 |
AC_DEFUN([SC_BLOCKING_STYLE], [
AC_CHECK_HEADERS(sys/ioctl.h)
AC_CHECK_HEADERS(sys/filio.h)
SC_CONFIG_SYSTEM
AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O])
case $system in
OSF*)
| < < < < | 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 |
AC_DEFUN([SC_BLOCKING_STYLE], [
AC_CHECK_HEADERS(sys/ioctl.h)
AC_CHECK_HEADERS(sys/filio.h)
SC_CONFIG_SYSTEM
AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O])
case $system in
OSF*)
AC_DEFINE(USE_FIONBIO, 1, [Should we use FIONBIO?])
AC_MSG_RESULT([FIONBIO])
;;
*)
AC_MSG_RESULT([O_NONBLOCK])
;;
esac
|
| ︙ | ︙ |
Changes to unix/tclUnixTime.c.
| ︙ | ︙ | |||
83 84 85 86 87 88 89 90 91 92 93 94 95 96 |
{
return time(NULL);
}
/*
*----------------------------------------------------------------------
*
* TclpGetClicks --
*
* This procedure returns a value that represents the highest resolution
* clock available on the system. There are no garantees on what the
* resolution will be. In Tcl we will call this value a "click". The
* start time is also system dependant.
*
| > > > > > > > > > > > > > > > > > > > > > > > > > > | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 |
{
return time(NULL);
}
/*
*----------------------------------------------------------------------
*
* TclpGetMicroseconds --
*
* This procedure returns the number of microseconds from the epoch.
* On most Unix systems the epoch is Midnight Jan 1, 1970 GMT.
*
* Results:
* Number of microseconds from the epoch.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_WideInt
TclpGetMicroseconds(void)
{
Tcl_Time time;
tclGetTimeProcPtr(&time, tclTimeClientData);
return ((Tcl_WideInt)time.sec)*1000000 + time.usec;
}
/*
*----------------------------------------------------------------------
*
* TclpGetClicks --
*
* This procedure returns a value that represents the highest resolution
* clock available on the system. There are no garantees on what the
* resolution will be. In Tcl we will call this value a "click". The
* start time is also system dependant.
*
|
| ︙ | ︙ | |||
215 216 217 218 219 220 221 222 223 224 225 226 227 228 |
#else
#error Wide high-resolution clicks not implemented on this platform
#endif
}
return nsec;
}
#endif /* TCL_WIDE_CLICKS */
/*
*----------------------------------------------------------------------
*
* Tcl_GetTime --
*
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 |
#else
#error Wide high-resolution clicks not implemented on this platform
#endif
}
return nsec;
}
/*
*----------------------------------------------------------------------
*
* TclpWideClickInMicrosec --
*
* This procedure return scale to convert click values from the
* TclpGetWideClicks native resolution to microsecond resolution
* and back.
*
* Results:
* 1 click in microseconds as double.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
double
TclpWideClickInMicrosec(void)
{
if (tclGetTimeProcPtr != NativeGetTime) {
return 1.0;
} else {
#ifdef MAC_OSX_TCL
static int initialized = 0;
static double scale = 0.0;
if (initialized) {
return scale;
} else {
mach_timebase_info_data_t tb;
mach_timebase_info(&tb);
/* value of tb.numer / tb.denom = 1 click in nanoseconds */
scale = ((double)tb.numer) / tb.denom / 1000;
initialized = 1;
return scale;
}
#else
#error Wide high-resolution clicks not implemented on this platform
#endif
}
}
#endif /* TCL_WIDE_CLICKS */
/*
*----------------------------------------------------------------------
*
* Tcl_GetTime --
*
|
| ︙ | ︙ |
Changes to win/Makefile.in.
| ︙ | ︙ | |||
224 225 226 227 228 229 230 231 232 233 234 235 236 237 | tclAlloc.$(OBJEXT) \ tclAssembly.$(OBJEXT) \ tclAsync.$(OBJEXT) \ tclBasic.$(OBJEXT) \ tclBinary.$(OBJEXT) \ tclCkalloc.$(OBJEXT) \ tclClock.$(OBJEXT) \ tclCmdAH.$(OBJEXT) \ tclCmdIL.$(OBJEXT) \ tclCmdMZ.$(OBJEXT) \ tclCompCmds.$(OBJEXT) \ tclCompCmdsGR.$(OBJEXT) \ tclCompCmdsSZ.$(OBJEXT) \ tclCompExpr.$(OBJEXT) \ | > | 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 | tclAlloc.$(OBJEXT) \ tclAssembly.$(OBJEXT) \ tclAsync.$(OBJEXT) \ tclBasic.$(OBJEXT) \ tclBinary.$(OBJEXT) \ tclCkalloc.$(OBJEXT) \ tclClock.$(OBJEXT) \ tclClockFmt.$(OBJEXT) \ tclCmdAH.$(OBJEXT) \ tclCmdIL.$(OBJEXT) \ tclCmdMZ.$(OBJEXT) \ tclCompCmds.$(OBJEXT) \ tclCompCmdsGR.$(OBJEXT) \ tclCompCmdsSZ.$(OBJEXT) \ tclCompExpr.$(OBJEXT) \ |
| ︙ | ︙ | |||
286 287 288 289 290 291 292 293 294 295 296 297 298 299 | tclPreserve.$(OBJEXT) \ tclProc.$(OBJEXT) \ tclRegexp.$(OBJEXT) \ tclResolve.$(OBJEXT) \ tclResult.$(OBJEXT) \ tclScan.$(OBJEXT) \ tclStringObj.$(OBJEXT) \ tclStrToD.$(OBJEXT) \ tclStubInit.$(OBJEXT) \ tclThread.$(OBJEXT) \ tclThreadAlloc.$(OBJEXT) \ tclThreadJoin.$(OBJEXT) \ tclThreadStorage.$(OBJEXT) \ tclTimer.$(OBJEXT) \ | > | 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 | tclPreserve.$(OBJEXT) \ tclProc.$(OBJEXT) \ tclRegexp.$(OBJEXT) \ tclResolve.$(OBJEXT) \ tclResult.$(OBJEXT) \ tclScan.$(OBJEXT) \ tclStringObj.$(OBJEXT) \ tclStrIdxTree.$(OBJEXT) \ tclStrToD.$(OBJEXT) \ tclStubInit.$(OBJEXT) \ tclThread.$(OBJEXT) \ tclThreadAlloc.$(OBJEXT) \ tclThreadJoin.$(OBJEXT) \ tclThreadStorage.$(OBJEXT) \ tclTimer.$(OBJEXT) \ |
| ︙ | ︙ |
Changes to win/makefile.vc.
| ︙ | ︙ | |||
266 267 268 269 270 271 272 273 274 275 276 277 278 279 | $(TMP_DIR)\tclAlloc.obj \ $(TMP_DIR)\tclAssembly.obj \ $(TMP_DIR)\tclAsync.obj \ $(TMP_DIR)\tclBasic.obj \ $(TMP_DIR)\tclBinary.obj \ $(TMP_DIR)\tclCkalloc.obj \ $(TMP_DIR)\tclClock.obj \ $(TMP_DIR)\tclCmdAH.obj \ $(TMP_DIR)\tclCmdIL.obj \ $(TMP_DIR)\tclCmdMZ.obj \ $(TMP_DIR)\tclCompCmds.obj \ $(TMP_DIR)\tclCompCmdsGR.obj \ $(TMP_DIR)\tclCompCmdsSZ.obj \ $(TMP_DIR)\tclCompExpr.obj \ | > | 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 | $(TMP_DIR)\tclAlloc.obj \ $(TMP_DIR)\tclAssembly.obj \ $(TMP_DIR)\tclAsync.obj \ $(TMP_DIR)\tclBasic.obj \ $(TMP_DIR)\tclBinary.obj \ $(TMP_DIR)\tclCkalloc.obj \ $(TMP_DIR)\tclClock.obj \ $(TMP_DIR)\tclClockFmt.obj \ $(TMP_DIR)\tclCmdAH.obj \ $(TMP_DIR)\tclCmdIL.obj \ $(TMP_DIR)\tclCmdMZ.obj \ $(TMP_DIR)\tclCompCmds.obj \ $(TMP_DIR)\tclCompCmdsGR.obj \ $(TMP_DIR)\tclCompCmdsSZ.obj \ $(TMP_DIR)\tclCompExpr.obj \ |
| ︙ | ︙ | |||
328 329 330 331 332 333 334 335 336 337 338 339 340 341 | $(TMP_DIR)\tclPreserve.obj \ $(TMP_DIR)\tclProc.obj \ $(TMP_DIR)\tclRegexp.obj \ $(TMP_DIR)\tclResolve.obj \ $(TMP_DIR)\tclResult.obj \ $(TMP_DIR)\tclScan.obj \ $(TMP_DIR)\tclStringObj.obj \ $(TMP_DIR)\tclStrToD.obj \ $(TMP_DIR)\tclStubInit.obj \ $(TMP_DIR)\tclThread.obj \ $(TMP_DIR)\tclThreadAlloc.obj \ $(TMP_DIR)\tclThreadJoin.obj \ $(TMP_DIR)\tclThreadStorage.obj \ $(TMP_DIR)\tclTimer.obj \ | > | 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 | $(TMP_DIR)\tclPreserve.obj \ $(TMP_DIR)\tclProc.obj \ $(TMP_DIR)\tclRegexp.obj \ $(TMP_DIR)\tclResolve.obj \ $(TMP_DIR)\tclResult.obj \ $(TMP_DIR)\tclScan.obj \ $(TMP_DIR)\tclStringObj.obj \ $(TMP_DIR)\tclStrIdxTree.obj \ $(TMP_DIR)\tclStrToD.obj \ $(TMP_DIR)\tclStubInit.obj \ $(TMP_DIR)\tclThread.obj \ $(TMP_DIR)\tclThreadAlloc.obj \ $(TMP_DIR)\tclThreadJoin.obj \ $(TMP_DIR)\tclThreadStorage.obj \ $(TMP_DIR)\tclTimer.obj \ |
| ︙ | ︙ |
Changes to win/tclWinTime.c.
| ︙ | ︙ | |||
106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 |
0,
0,
#endif
{ 0 },
{ 0 },
0
};
/*
* Declarations for functions defined later in this file.
*/
#ifndef TCL_NO_DEPRECATED
static struct tm * ComputeGMT(const time_t *tp);
#endif /* TCL_NO_DEPRECATED */
static void StopCalibration(ClientData clientData);
static DWORD WINAPI CalibrationThread(LPVOID arg);
static void UpdateTimeEachSecond(void);
static void ResetCounterSamples(Tcl_WideUInt fileTime,
Tcl_WideInt perfCounter, Tcl_WideInt perfFreq);
static Tcl_WideInt AccumulateSample(Tcl_WideInt perfCounter,
Tcl_WideUInt fileTime);
static void NativeScaleTime(Tcl_Time* timebuf,
ClientData clientData);
static void NativeGetTime(Tcl_Time* timebuf,
ClientData clientData);
/*
* TIP #233 (Virtualized Time): Data for the time hooks, if any.
*/
| > > > > > > > > > > > > | 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 |
0,
0,
#endif
{ 0 },
{ 0 },
0
};
/*
* Scale to convert wide click values from the TclpGetWideClicks native
* resolution to microsecond resolution and back.
*/
static struct {
int initialized; /* 1 if initialized, 0 otherwise */
int perfCounter; /* 1 if performance counter usable for wide clicks */
double microsecsScale; /* Denominator scale between clock / microsecs */
} wideClick = {0, 0.0};
/*
* Declarations for functions defined later in this file.
*/
#ifndef TCL_NO_DEPRECATED
static struct tm * ComputeGMT(const time_t *tp);
#endif /* TCL_NO_DEPRECATED */
static void StopCalibration(ClientData clientData);
static DWORD WINAPI CalibrationThread(LPVOID arg);
static void UpdateTimeEachSecond(void);
static void ResetCounterSamples(Tcl_WideUInt fileTime,
Tcl_WideInt perfCounter, Tcl_WideInt perfFreq);
static Tcl_WideInt AccumulateSample(Tcl_WideInt perfCounter,
Tcl_WideUInt fileTime);
static void NativeScaleTime(Tcl_Time* timebuf,
ClientData clientData);
static Tcl_WideInt NativeGetMicroseconds(void);
static void NativeGetTime(Tcl_Time* timebuf,
ClientData clientData);
/*
* TIP #233 (Virtualized Time): Data for the time hooks, if any.
*/
|
| ︙ | ︙ | |||
154 155 156 157 158 159 160 |
*
*----------------------------------------------------------------------
*/
unsigned long
TclpGetSeconds(void)
{
| > > > > > > > > | | | > | 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 |
*
*----------------------------------------------------------------------
*/
unsigned long
TclpGetSeconds(void)
{
Tcl_WideInt usecSincePosixEpoch;
/* Try to use high resolution timer */
if ( tclGetTimeProcPtr == NativeGetTime
&& (usecSincePosixEpoch = NativeGetMicroseconds())
) {
return usecSincePosixEpoch / 1000000;
} else {
Tcl_Time t;
tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */
return t.sec;
}
}
/*
*----------------------------------------------------------------------
*
* TclpGetClicks --
*
|
| ︙ | ︙ | |||
182 183 184 185 186 187 188 |
*
*----------------------------------------------------------------------
*/
unsigned long
TclpGetClicks(void)
{
| > > > > > > > > | | | | | < | > | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > | 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 |
*
*----------------------------------------------------------------------
*/
unsigned long
TclpGetClicks(void)
{
Tcl_WideInt usecSincePosixEpoch;
/* Try to use high resolution timer */
if ( tclGetTimeProcPtr == NativeGetTime
&& (usecSincePosixEpoch = NativeGetMicroseconds())
) {
return (unsigned long)usecSincePosixEpoch;
} else {
/*
* Use the Tcl_GetTime abstraction to get the time in microseconds, as
* nearly as we can, and return it.
*/
Tcl_Time now; /* Current Tcl time */
tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */
return (unsigned long)(now.sec * 1000000) + now.usec;
}
}
/*
*----------------------------------------------------------------------
*
* TclpGetWideClicks --
*
* This procedure returns a WideInt value that represents the highest
* resolution clock in microseconds available on the system.
*
* Results:
* Number of microseconds (from some start time).
*
* Side effects:
* This should be used for time-delta resp. for measurement purposes
* only, because on some platforms can return microseconds from some
* start time (not from the epoch).
*
*----------------------------------------------------------------------
*/
Tcl_WideInt
TclpGetWideClicks(void)
{
LARGE_INTEGER curCounter;
if (!wideClick.initialized) {
LARGE_INTEGER perfCounterFreq;
/*
* The frequency of the performance counter is fixed at system boot and
* is consistent across all processors. Therefore, the frequency need
* only be queried upon application initialization.
*/
if (QueryPerformanceFrequency(&perfCounterFreq)) {
wideClick.perfCounter = 1;
wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart;
} else {
/* fallback using microseconds */
wideClick.perfCounter = 0;
wideClick.microsecsScale = 1;
}
wideClick.initialized = 1;
}
if (wideClick.perfCounter) {
if (QueryPerformanceCounter(&curCounter)) {
return (Tcl_WideInt)curCounter.QuadPart;
}
/* fallback using microseconds */
wideClick.perfCounter = 0;
wideClick.microsecsScale = 1;
return TclpGetMicroseconds();
} else {
return TclpGetMicroseconds();
}
}
/*
*----------------------------------------------------------------------
*
* TclpWideClickInMicrosec --
*
* This procedure return scale to convert wide click values from the
* TclpGetWideClicks native resolution to microsecond resolution
* and back.
*
* Results:
* 1 click in microseconds as double.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
double
TclpWideClickInMicrosec(void)
{
if (!wideClick.initialized) {
(void)TclpGetWideClicks(); /* initialize */
}
return wideClick.microsecsScale;
}
/*
*----------------------------------------------------------------------
*
* TclpGetMicroseconds --
*
* This procedure returns a WideInt value that represents the highest
* resolution clock in microseconds available on the system.
*
* Results:
* Number of microseconds (from the epoch).
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_WideInt
TclpGetMicroseconds(void)
{
Tcl_WideInt usecSincePosixEpoch;
/* Try to use high resolution timer */
if ( tclGetTimeProcPtr == NativeGetTime
&& (usecSincePosixEpoch = NativeGetMicroseconds())
) {
return usecSincePosixEpoch;
} else {
/*
* Use the Tcl_GetTime abstraction to get the time in microseconds, as
* nearly as we can, and return it.
*/
Tcl_Time now;
tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */
return (((Tcl_WideInt)now.sec) * 1000000) + now.usec;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetTime --
*
|
| ︙ | ︙ | |||
223 224 225 226 227 228 229 |
*----------------------------------------------------------------------
*/
void
Tcl_GetTime(
Tcl_Time *timePtr) /* Location to store time information. */
{
| > > > > > > > > > | > | 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 |
*----------------------------------------------------------------------
*/
void
Tcl_GetTime(
Tcl_Time *timePtr) /* Location to store time information. */
{
Tcl_WideInt usecSincePosixEpoch;
/* Try to use high resolution timer */
if ( tclGetTimeProcPtr == NativeGetTime
&& (usecSincePosixEpoch = NativeGetMicroseconds())
) {
timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
} else {
tclGetTimeProcPtr(timePtr, tclTimeClientData);
}
}
/*
*----------------------------------------------------------------------
*
* NativeScaleTime --
*
|
| ︙ | ︙ | |||
256 257 258 259 260 261 262 |
* Native scale is 1:1. Nothing is done.
*/
}
/*
*----------------------------------------------------------------------
*
| | | | | > | | < < < | > > > > > > | 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 |
* Native scale is 1:1. Nothing is done.
*/
}
/*
*----------------------------------------------------------------------
*
* NativeGetMicroseconds --
*
* Gets the current system time in microseconds since the beginning
* of the epoch: 00:00 UCT, January 1, 1970.
*
* Results:
* Returns the wide integer with number of microseconds from the epoch, or
* 0 if high resolution timer is not available.
*
* Side effects:
* On the first call, initializes a set of static variables to keep track
* of the base value of the performance counter, the corresponding wall
* clock (obtained through ftime) and the frequency of the performance
* counter. Also spins a thread whose function is to wake up periodically
* and monitor these values, adjusting them as necessary to correct for
* drift in the performance counter's oscillator.
*
*----------------------------------------------------------------------
*/
static Tcl_WideInt
NativeGetMicroseconds(void)
{
static LARGE_INTEGER posixEpoch;
/* Posix epoch expressed as 100-ns ticks since
* the windows epoch. */
/*
* Initialize static storage on the first trip through.
*
* Note: Outer check for 'initialized' is a performance win since it
* avoids an extra mutex lock in the common case.
*/
if (!timeInfo.initialized) {
TclpInitLock();
if (!timeInfo.initialized) {
posixEpoch.LowPart = 0xD53E8000;
posixEpoch.HighPart = 0x019DB1DE;
timeInfo.perfCounterAvailable =
QueryPerformanceFrequency(&timeInfo.nominalFreq);
/*
* Some hardware abstraction layers use the CPU clock in place of
* the real-time clock as a performance counter reference. This
* results in:
|
| ︙ | ︙ | |||
404 405 406 407 408 409 410 | LARGE_INTEGER perfCounterLastCall, curCounterFreq; /* Copy with current data of calibration cycle */ LARGE_INTEGER curCounter; /* Current performance counter. */ Tcl_WideInt curFileTime;/* Current estimated time, expressed as 100-ns * ticks since the Windows epoch. */ | < < < < < < < < | | > > | > > > | | | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > | | | > | 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 |
LARGE_INTEGER perfCounterLastCall, curCounterFreq;
/* Copy with current data of calibration cycle */
LARGE_INTEGER curCounter;
/* Current performance counter. */
Tcl_WideInt curFileTime;/* Current estimated time, expressed as 100-ns
* ticks since the Windows epoch. */
Tcl_WideInt usecSincePosixEpoch;
/* Current microseconds since Posix epoch. */
QueryPerformanceCounter(&curCounter);
/*
* Hold time section locked as short as possible
*/
EnterCriticalSection(&timeInfo.cs);
fileTimeLastCall.QuadPart = timeInfo.fileTimeLastCall.QuadPart;
perfCounterLastCall.QuadPart = timeInfo.perfCounterLastCall.QuadPart;
curCounterFreq.QuadPart = timeInfo.curCounterFreq.QuadPart;
LeaveCriticalSection(&timeInfo.cs);
/*
* If calibration cycle occurred after we get curCounter
*/
if (curCounter.QuadPart <= perfCounterLastCall.QuadPart) {
usecSincePosixEpoch =
(fileTimeLastCall.QuadPart - posixEpoch.QuadPart) / 10;
return usecSincePosixEpoch;
}
/*
* If it appears to be more than 1.1 seconds since the last trip
* through the calibration loop, the performance counter may have
* jumped forward. (See MSDN Knowledge Base article Q274323 for a
* description of the hardware problem that makes this test
* necessary.) If the counter jumps, we don't want to use it directly.
* Instead, we must return system time. Eventually, the calibration
* loop should recover.
*/
if (curCounter.QuadPart - perfCounterLastCall.QuadPart <
11 * curCounterFreq.QuadPart / 10
) {
curFileTime = fileTimeLastCall.QuadPart +
((curCounter.QuadPart - perfCounterLastCall.QuadPart)
* 10000000 / curCounterFreq.QuadPart);
usecSincePosixEpoch = (curFileTime - posixEpoch.QuadPart) / 10;
return usecSincePosixEpoch;
}
}
/*
* High resolution timer is not available.
*/
return 0;
}
/*
*----------------------------------------------------------------------
*
* NativeGetTime --
*
* TIP #233: Gets the current system time in seconds and microseconds
* since the beginning of the epoch: 00:00 UCT, January 1, 1970.
*
* Results:
* Returns the current time in timePtr.
*
* Side effects:
* See NativeGetMicroseconds for more information.
*
*----------------------------------------------------------------------
*/
static void
NativeGetTime(
Tcl_Time *timePtr,
ClientData clientData)
{
Tcl_WideInt usecSincePosixEpoch;
/*
* Try to use high resolution timer.
*/
if ( (usecSincePosixEpoch = NativeGetMicroseconds()) ) {
timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
} else {
/*
* High resolution timer is not available. Just use ftime.
*/
struct _timeb t;
_ftime(&t);
timePtr->sec = (long)t.time;
timePtr->usec = t.millitm * 1000;
}
}
/*
*----------------------------------------------------------------------
*
* StopCalibration --
*
|
| ︙ | ︙ |